diff options
Diffstat (limited to 'testsuite')
2146 files changed, 37092 insertions, 11158 deletions
diff --git a/testsuite/.gitignore b/testsuite/.gitignore index e6934f966a..7c4453e58a 100644 --- a/testsuite/.gitignore +++ b/testsuite/.gitignore @@ -776,6 +776,7 @@ mk/ghcconfig*_test___spaces_ghc*.exe.mk /tests/ghci/linking/dir004/ /tests/ghci/linking/dir005/ /tests/ghci/linking/dir006/ +/tests/ghci/linking/T14708scratch/ /tests/ghci/prog001/C.hs /tests/ghci/prog001/D.hs /tests/ghci/prog002/A.hs diff --git a/testsuite/config/ghc b/testsuite/config/ghc index 6296394197..e974b62a96 100644 --- a/testsuite/config/ghc +++ b/testsuite/config/ghc @@ -33,7 +33,7 @@ config.other_ways = ['prof', 'normal_h', 'ghci-ext', 'ghci-ext-prof', 'ext-interp'] -if (ghc_with_native_codegen == 1): +if ghc_with_native_codegen: config.compile_ways.append('optasm') config.run_ways.append('optasm') @@ -44,25 +44,25 @@ if config.have_profiling: if config.have_interp: config.run_ways.append('ghci') -if (ghc_with_threaded_rts == 1): +if ghc_with_threaded_rts: config.run_ways.append('threaded1') - if (ghc_with_smp == 1): + if ghc_with_smp: config.have_smp = True config.run_ways.append('threaded2') -if (ghc_with_dynamic_rts == 1): +if ghc_with_dynamic_rts: config.have_shared_libs = True if config.ghc_dynamic_by_default and config.have_vanilla == 1: config.run_ways.append('static') else: - if (ghc_with_dynamic_rts == 1): + if ghc_with_dynamic_rts: config.run_ways.append('dyn') -if (config.have_profiling and ghc_with_threaded_rts == 1): +if (config.have_profiling and ghc_with_threaded_rts): config.run_ways.append('profthreaded') -if (ghc_with_llvm == 1 and not config.unregisterised): +if (ghc_with_llvm and not config.unregisterised): config.compile_ways.append('optllvm') config.run_ways.append('optllvm') @@ -80,7 +80,7 @@ config.way_flags = { 'prof_no_auto' : ['-prof', '-static', '-fasm'], 'profasm' : ['-O', '-prof', '-static', '-fprof-auto'], 'profthreaded' : ['-O', '-prof', '-static', '-fprof-auto', '-threaded'], - 'ghci' : ['--interactive', '-v0', '-ignore-dot-ghci', '-fno-ghci-history', '+RTS', '-I0.1', '-RTS'], + 'ghci' : ['--interactive', '-v0', '-ignore-dot-ghci', '-fno-ghci-history', '+RTS', '-I0.1', '-RTS'] + (['-fghci-leak-check'] if not config.compiler_debugged else []), 'sanity' : ['-debug'], 'threaded1' : ['-threaded', '-debug'], 'threaded1_ls' : ['-threaded', '-debug'], @@ -158,10 +158,10 @@ llvm_ways = [x[0] for x in config.way_flags.items() if '-fflvm' in x[1]] def get_compiler_info(): - s = getStdout([config.compiler, '--info']).decode('utf8') + s = getStdout([config.compiler, '--info']) s = re.sub('[\r\n]', '', s) compilerInfoDict = dict(eval(s)) - s = getStdout([config.compiler, '+RTS', '--info']).decode('utf8') + s = getStdout([config.compiler, '+RTS', '--info']) s = re.sub('[\r\n]', '', s) rtsInfoDict = dict(eval(s)) diff --git a/testsuite/driver/junit.py b/testsuite/driver/junit.py new file mode 100644 index 0000000000..f2dbebb96a --- /dev/null +++ b/testsuite/driver/junit.py @@ -0,0 +1,38 @@ +from datetime import datetime +import xml.etree.ElementTree as ET + +def junit(t): + testsuites = ET.Element('testsuites') + testsuite = ET.SubElement(testsuites, 'testsuite', + id = "0", + package = 'ghc', + tests = str(t.total_tests), + failures = str(len(t.unexpected_failures) + len(t.unexpected_stat_failures)), + errors = str(len(t.framework_failures)), + timestamp = datetime.now().isoformat()) + + for res_type, group in [('stat failure', t.unexpected_stat_failures), + ('unexpected failure', t.unexpected_failures)]: + for (directory, testname, reason, way) in group: + testcase = ET.SubElement(testsuite, 'testcase', + classname = testname, + name = way) + result = ET.SubElement(testcase, 'failure', + type = res_type, + message = reason) + + for (directory, testname, reason, way) in t.framework_failures: + testcase = ET.SubElement(testsuite, 'testcase', + classname = testname, + name = way) + result = ET.SubElement(testcase, 'error', + type = "framework failure", + message = reason) + + for (directory, testname, way) in t.expected_passes: + testcase = ET.SubElement(testsuite, 'testcase', + classname = testname, + name = way) + + return ET.ElementTree(testsuites) + diff --git a/testsuite/driver/runtests.py b/testsuite/driver/runtests.py index 7e4f375a2c..b956239d2a 100644 --- a/testsuite/driver/runtests.py +++ b/testsuite/driver/runtests.py @@ -4,17 +4,16 @@ # (c) Simon Marlow 2002 # -from __future__ import print_function - +import argparse import signal import sys import os -import string -import getopt +import io import shutil import tempfile import time import re +import traceback # We don't actually need subprocess in runtests.py, but: # * We do need it in testlibs.py @@ -24,13 +23,15 @@ import re # So we import it here first, so that the testsuite doesn't appear to fail. import subprocess -from testutil import * -from testglobals import * +from testutil import getStdout, Watcher +from testglobals import getConfig, ghc_env, getTestRun, TestOptions, brokens +from junit import junit # Readline sometimes spews out ANSI escapes for some values of TERM, # which result in test failures. Thus set TERM to a nice, simple, safe # value. os.environ['TERM'] = 'vt100' +ghc_env['TERM'] = 'vt100' global config config = getConfig() # get it from testglobals @@ -41,81 +42,69 @@ def signal_handler(signal, frame): # ----------------------------------------------------------------------------- # cmd-line options -long_options = [ - "configfile=", # config file - "config=", # config field - "rootdir=", # root of tree containing tests (default: .) - "summary-file=", # file in which to save the (human-readable) summary - "no-print-summary=", # should we print the summary? - "only=", # just this test (can be give multiple --only= flags) - "way=", # just this way - "skipway=", # skip this way - "threads=", # threads to run simultaneously - "check-files-written", # check files aren't written by multiple tests - "verbose=", # verbose (0,1,2 so far) - "skip-perf-tests", # skip performance tests - ] - -opts, args = getopt.getopt(sys.argv[1:], "e:", long_options) - -for opt,arg in opts: - if opt == '--configfile': - exec(open(arg).read()) - - # -e is a string to execute from the command line. For example: - # testframe -e 'config.compiler=ghc-5.04' - if opt == '-e': - exec(arg) - - if opt == '--config': - field, value = arg.split('=', 1) - setattr(config, field, value) - - if opt == '--rootdir': - config.rootdirs.append(arg) - - if opt == '--summary-file': - config.summary_file = arg - - if opt == '--no-print-summary': - config.no_print_summary = True - - if opt == '--only': - config.run_only_some_tests = True - config.only.add(arg) - - if opt == '--way': - if (arg not in config.run_ways and arg not in config.compile_ways and arg not in config.other_ways): - sys.stderr.write("ERROR: requested way \'" + - arg + "\' does not exist\n") - sys.exit(1) - config.cmdline_ways = [arg] + config.cmdline_ways - if (arg in config.other_ways): - config.run_ways = [arg] + config.run_ways - config.compile_ways = [arg] + config.compile_ways - - if opt == '--skipway': - if (arg not in config.run_ways and arg not in config.compile_ways and arg not in config.other_ways): - sys.stderr.write("ERROR: requested way \'" + - arg + "\' does not exist\n") - sys.exit(1) - config.other_ways = [w for w in config.other_ways if w != arg] - config.run_ways = [w for w in config.run_ways if w != arg] - config.compile_ways = [w for w in config.compile_ways if w != arg] - - if opt == '--threads': - config.threads = int(arg) - config.use_threads = 1 - - if opt == '--skip-perf-tests': - config.skip_perf_tests = True - - if opt == '--verbose': - if arg not in ["0","1","2","3","4","5"]: - sys.stderr.write("ERROR: requested verbosity %s not supported, use 0,1,2,3,4 or 5" % arg) - sys.exit(1) - config.verbose = int(arg) - +parser = argparse.ArgumentParser(description="GHC's testsuite driver") + +parser.add_argument("-e", action='append', help="A string to execute from the command line.") +parser.add_argument("--config-file", action="append", help="config file") +parser.add_argument("--config", action='append', help="config field") +parser.add_argument("--rootdir", action='append', help="root of tree containing tests (default: .)") +parser.add_argument("--summary-file", help="file in which to save the (human-readable) summary") +parser.add_argument("--no-print-summary", action="store_true", help="should we print the summary?") +parser.add_argument("--only", action="append", help="just this test (can be give multiple --only= flags)") +parser.add_argument("--way", action="append", help="just this way") +parser.add_argument("--skipway", action="append", help="skip this way") +parser.add_argument("--threads", type=int, help="threads to run simultaneously") +parser.add_argument("--verbose", type=int, choices=[0,1,2,3,4,5], help="verbose (Values 0 through 5 accepted)") +parser.add_argument("--skip-perf-tests", action="store_true", help="skip performance tests") +parser.add_argument("--junit", type=argparse.FileType('wb'), help="output testsuite summary in JUnit format") + +args = parser.parse_args() + +for e in args.e: + exec(e) + +for arg in args.config_file: + exec(open(arg).read()) + +for arg in args.config: + field, value = arg.split('=', 1) + setattr(config, field, value) + +all_ways = config.run_ways+config.compile_ways+config.other_ways +config.rootdirs = args.rootdir +config.summary_file = args.summary_file +config.no_print_summary = args.no_print_summary + +if args.only: + config.only = args.only + config.run_only_some_tests = True + +if args.way: + for way in args.way: + if way not in all_ways: + print('WARNING: Unknown WAY %s in --way' % way) + else: + config.cmdline_ways += [way] + if way in config.other_ways: + config.run_ways += [way] + config.compile_ways += [way] + +if args.skipway: + for way in args.skipway: + if way not in all_ways: + print('WARNING: Unknown WAY %s in --skipway' % way) + + config.other_ways = [w for w in config.other_ways if w not in args.skipway] + config.run_ways = [w for w in config.run_ways if w not in args.skipway] + config.compile_ways = [w for w in config.compile_ways if w not in args.skipway] + +if args.threads: + config.threads = args.threads + config.use_threads = True + +if args.verbose is not None: + config.verbose = args.verbose +config.skip_perf_tests = args.skip_perf_tests config.cygwin = False config.msys = False @@ -161,7 +150,7 @@ else: h.close() if v == '': # We don't, so now see if 'locale -a' works - h = os.popen('locale -a', 'r') + h = os.popen('locale -a | grep -F .', 'r') v = h.read() h.close() if v != '': @@ -171,6 +160,7 @@ else: h.close() if v != '': os.environ['LC_ALL'] = v + ghc_env['LC_ALL'] = v print("setting LC_ALL to", v) else: print('WARNING: No UTF8 locale found.') @@ -183,14 +173,30 @@ get_compiler_info() # enabled or not from testlib import * +def format_path(path): + if windows: + if os.pathsep == ':': + # If using msys2 python instead of mingw we have to change the drive + # letter representation. Otherwise it thinks we're adding two env + # variables E and /Foo when we add E:/Foo. + path = re.sub('([a-zA-Z]):', '/\\1', path) + if config.cygwin: + # On cygwin we can't put "c:\foo" in $PATH, as : is a + # field separator. So convert to /cygdrive/c/foo instead. + # Other pythons use ; as the separator, so no problem. + path = re.sub('([a-zA-Z]):', '/cygdrive/\\1', path) + path = re.sub('\\\\', '/', path) + return path + # On Windows we need to set $PATH to include the paths to all the DLLs # in order for the dynamic library tests to work. if windows or darwin: - pkginfo = str(getStdout([config.ghc_pkg, 'dump'])) + pkginfo = getStdout([config.ghc_pkg, 'dump']) topdir = config.libdir if windows: - mingw = os.path.join(topdir, '../mingw/bin') - os.environ['PATH'] = os.pathsep.join([os.environ.get("PATH", ""), mingw]) + mingw = os.path.abspath(os.path.join(topdir, '../mingw/bin')) + mingw = format_path(mingw) + ghc_env['PATH'] = os.pathsep.join([ghc_env.get("PATH", ""), mingw]) for line in pkginfo.split('\n'): if line.startswith('library-dirs:'): path = line.rstrip() @@ -203,18 +209,12 @@ if windows or darwin: path = re.sub('^"(.*)"$', '\\1', path) path = re.sub('\\\\(.)', '\\1', path) if windows: - if config.cygwin: - # On cygwin we can't put "c:\foo" in $PATH, as : is a - # field separator. So convert to /cygdrive/c/foo instead. - # Other pythons use ; as the separator, so no problem. - path = re.sub('([a-zA-Z]):', '/cygdrive/\\1', path) - path = re.sub('\\\\', '/', path) - os.environ['PATH'] = os.pathsep.join([path, os.environ.get("PATH", "")]) + path = format_path(path) + ghc_env['PATH'] = os.pathsep.join([path, ghc_env.get("PATH", "")]) else: # darwin - os.environ['DYLD_LIBRARY_PATH'] = os.pathsep.join([path, os.environ.get("DYLD_LIBRARY_PATH", "")]) + ghc_env['DYLD_LIBRARY_PATH'] = os.pathsep.join([path, ghc_env.get("DYLD_LIBRARY_PATH", "")]) -global testopts_local testopts_local.x = TestOptions() # if timeout == -1 then we try to calculate a sensible value @@ -286,51 +286,63 @@ for name in config.only: framework_fail(name, '', 'test not found') else: # Let user fix .T file errors before reporting on unfound tests. - # The reson the test can not be found is likely because of those + # The reason the test can not be found is likely because of those # .T file errors. pass if config.list_broken: - global brokens print('') print('Broken tests:') print(' '.join(map (lambda bdn: '#' + str(bdn[0]) + '(' + bdn[1] + '/' + bdn[2] + ')', brokens))) print('') if t.framework_failures: - print('WARNING:', len(framework_failures), 'framework failures!') + print('WARNING:', len(t.framework_failures), 'framework failures!') print('') else: # completion watcher watcher = Watcher(len(parallelTests)) # Now run all the tests - for oneTest in parallelTests: - if stopping(): - break - oneTest(watcher) - - # wait for parallel tests to finish - if not stopping(): - watcher.wait() - - # Run the following tests purely sequential - config.use_threads = False - for oneTest in aloneTests: - if stopping(): - break - oneTest(watcher) + try: + for oneTest in parallelTests: + if stopping(): + break + oneTest(watcher) + + # wait for parallel tests to finish + if not stopping(): + watcher.wait() + + # Run the following tests purely sequential + config.use_threads = False + for oneTest in aloneTests: + if stopping(): + break + oneTest(watcher) + except KeyboardInterrupt: + pass # flush everything before we continue sys.stdout.flush() summary(t, sys.stdout, config.no_print_summary) - if config.summary_file != '': + if config.summary_file: with open(config.summary_file, 'w') as file: summary(t, file) -cleanup_and_exit(0) + if args.junit: + junit(t).write(args.junit) + +if len(t.unexpected_failures) > 0 or \ + len(t.unexpected_stat_failures) > 0 or \ + len(t.framework_failures) > 0: + exitcode = 1 +else: + exitcode = 0 + +cleanup_and_exit(exitcode) # Note [Running tests in /tmp] # diff --git a/testsuite/driver/testglobals.py b/testsuite/driver/testglobals.py index fc050e6908..311e39be7f 100644 --- a/testsuite/driver/testglobals.py +++ b/testsuite/driver/testglobals.py @@ -1,4 +1,4 @@ -# +# # (c) Simon Marlow 2002 # @@ -9,7 +9,7 @@ # variable config below. The fields of the structure are filled in by # the appropriate config script(s) for this compiler/platform, in # ../config. -# +# # Bits of the structure may also be filled in from the command line, # via the build system, using the '-e' option to runtests. @@ -27,7 +27,9 @@ class TestConfig: self.only = set() # Accept new output which differs from the sample? - self.accept = 0 + self.accept = False + self.accept_platform = False + self.accept_os = False # File in which to save the summary self.summary_file = '' @@ -41,9 +43,6 @@ class TestConfig: # with --verbose=0. self.no_print_summary = False - # File in which to save the times - self.times_file = '' - # What platform are we running on? self.platform = '' self.os = '' @@ -70,7 +69,7 @@ class TestConfig: # Flags we always give to this compiler self.compiler_always_flags = [] - + # Which ways to run tests (when compiling and running respectively) # Other ways are added from the command line if we have the appropriate # libraries. @@ -103,16 +102,22 @@ class TestConfig: # Do we have SMP support? self.have_smp = False + # Is gdb avaliable? + self.have_gdb = False + + # Is readelf available? + self.have_readelf = False + # Are we testing an in-tree compiler? self.in_tree_compiler = True # the timeout program self.timeout_prog = '' self.timeout = 300 - + # threads self.threads = 1 - self.use_threads = 0 + self.use_threads = False # Should we skip performance tests self.skip_perf_tests = False @@ -123,6 +128,12 @@ config = TestConfig() def getConfig(): return config +import os +# Hold our modified GHC testrunning environment so we don't poison the current +# python's environment. +global ghc_env +ghc_env = os.environ.copy() + # ----------------------------------------------------------------------------- # Information about the current test run @@ -140,6 +151,7 @@ class TestRun: self.framework_failures = [] self.framework_warnings = [] + self.expected_passes = [] self.unexpected_passes = [] self.unexpected_failures = [] self.unexpected_stat_failures = [] @@ -156,7 +168,7 @@ def getTestRun(): class TestOptions: def __init__(self): # skip this test? - self.skip = 0 + self.skip = False # skip these ways self.omit_ways = [] @@ -181,7 +193,7 @@ class TestOptions: self.ignore_stderr = False # Backpack test - self.compile_backpack = 0 + self.compile_backpack = False # We sometimes want to modify the compiler_always_flags, so # they are copied from config.compiler_always_flags when we @@ -218,15 +230,15 @@ class TestOptions: self.alone = False # Does this test use a literate (.lhs) file? - self.literate = 0 + self.literate = False # Does this test use a .c, .m or .mm file? - self.c_src = 0 - self.objc_src = 0 - self.objcpp_src = 0 + self.c_src = False + self.objc_src = False + self.objcpp_src = False # Does this test use a .cmm file? - self.cmm_src = 0 + self.cmm_src = False # Should we put .hi/.o files in a subdirectory? self.outputdir = None @@ -234,9 +246,6 @@ class TestOptions: # Command to run before the test self.pre_cmd = None - # Command to run for extra cleaning - self.clean_cmd = None - # Command wrapper: a function to apply to the command before running it self.cmd_wrapper = None diff --git a/testsuite/driver/testlib.py b/testsuite/driver/testlib.py index 26e3d17679..ff6a8c8e74 100644 --- a/testsuite/driver/testlib.py +++ b/testsuite/driver/testlib.py @@ -3,13 +3,9 @@ # (c) Simon Marlow 2002 # -from __future__ import print_function - import io import shutil import os -import errno -import string import re import traceback import time @@ -18,33 +14,30 @@ import copy import glob import sys from math import ceil, trunc +from pathlib import PurePath import collections import subprocess -from testglobals import * -from testutil import * +from testglobals import config, ghc_env, default_testopts, brokens, t +from testutil import strip_quotes, lndir, link_or_copy_file extra_src_files = {'T4198': ['exitminus1.c']} # TODO: See #12223 +global pool_sema if config.use_threads: import threading - try: - import thread - except ImportError: # Python 3 - import _thread as thread + pool_sema = threading.BoundedSemaphore(value=config.threads) global wantToStop wantToStop = False -global pool_sema -if config.use_threads: - pool_sema = threading.BoundedSemaphore(value=config.threads) - def stopNow(): global wantToStop wantToStop = True + def stopping(): return wantToStop + # Options valid for the current test only (these get reset to # testdir_testopts after each test). @@ -91,7 +84,7 @@ def normal( name, opts ): return; def skip( name, opts ): - opts.skip = 1 + opts.skip = True def expect_fail( name, opts ): # The compiler, testdriver, OS or platform is missing a certain @@ -143,7 +136,8 @@ def _reqlib( name, opts, lib ): cmd = strip_quotes(config.ghc_pkg) p = subprocess.Popen([cmd, '--no-user-package-db', 'describe', lib], stdout=subprocess.PIPE, - stderr=subprocess.PIPE) + stderr=subprocess.PIPE, + env=ghc_env) # read from stdout and stderr to avoid blocking due to # buffers filling p.communicate() @@ -209,7 +203,6 @@ def _expect_broken_for( name, opts, bug, ways ): opts.expect_fail_for = ways def record_broken(name, opts, bug): - global brokens me = (bug, opts.testdir, name) if not me in brokens: brokens.append(me) @@ -412,6 +405,12 @@ def compiler_profiled( ): def compiler_debugged( ): return config.compiler_debugged +def have_gdb( ): + return config.have_gdb + +def have_readelf( ): + return config.have_readelf + # --- def high_memory_usage(name, opts): @@ -424,19 +423,19 @@ def multi_cpu_race(name, opts): # --- def literate( name, opts ): - opts.literate = 1; + opts.literate = True def c_src( name, opts ): - opts.c_src = 1; + opts.c_src = True def objc_src( name, opts ): - opts.objc_src = 1; + opts.objc_src = True def objcpp_src( name, opts ): - opts.objcpp_src = 1; + opts.objcpp_src = True def cmm_src( name, opts ): - opts.cmm_src = 1; + opts.cmm_src = True def outputdir( odir ): return lambda name, opts, d=odir: _outputdir(name, opts, d) @@ -454,12 +453,6 @@ def _pre_cmd( name, opts, cmd ): # ---- -def clean_cmd( cmd ): - # TODO. Remove all calls to clean_cmd. - return lambda _name, _opts: None - -# ---- - def cmd_prefix( prefix ): return lambda name, opts, p=prefix: _cmd_prefix(name, opts, prefix) @@ -497,7 +490,6 @@ def no_check_hp(name, opts): def filter_stdout_lines( regex ): """ Filter lines of stdout with the given regular expression """ - import re def f( name, opts ): _normalise_fun(name, opts, lambda s: '\n'.join(re.findall(regex, s))) return f @@ -520,6 +512,19 @@ def normalise_errmsg_fun( *fs ): def _normalise_errmsg_fun( name, opts, *fs ): opts.extra_errmsg_normaliser = join_normalisers(opts.extra_errmsg_normaliser, fs) +def check_errmsg(needle): + def norm(str): + if needle in str: + return "%s contained in -ddump-simpl\n" % needle + else: + return "%s not contained in -ddump-simpl\n" % needle + return normalise_errmsg_fun(norm) + +def grep_errmsg(needle): + def norm(str): + return "".join(filter(lambda l: re.search(needle, l), str.splitlines(True))) + return normalise_errmsg_fun(norm) + def normalise_whitespace_fun(f): return lambda name, opts: _normalise_whitespace_fun(name, opts, f) @@ -607,8 +612,9 @@ def newTestDir(tempdir, dir): testdir_suffix = '.run' def _newTestDir(name, opts, tempdir, dir): + testdir = os.path.join('', *(p for p in PurePath(dir).parts if p != '..')) opts.srcdir = os.path.join(os.getcwd(), dir) - opts.testdir = os.path.join(tempdir, dir, name + testdir_suffix) + opts.testdir = os.path.join(tempdir, testdir, name + testdir_suffix) opts.compiler_always_flags = config.compiler_always_flags # ----------------------------------------------------------------------------- @@ -796,7 +802,7 @@ def do_test(name, way, func, args, files): full_name = name + '(' + way + ')' if_verbose(2, "=====> {0} {1} of {2} {3}".format( - full_name, t.total_tests, len(allTestNames), + full_name, t.total_tests, len(allTestNames), [len(t.unexpected_passes), len(t.unexpected_failures), len(t.framework_failures)])) @@ -848,6 +854,7 @@ def do_test(name, way, func, args, files): if exit_code != 0: framework_fail(name, way, 'pre_cmd failed: {0}'.format(exit_code)) + if_verbose(1, '** pre_cmd was "{0}". Running trace'.format(override_options(opts.pre_cmd))) result = func(*[name,way] + args) @@ -863,6 +870,7 @@ def do_test(name, way, func, args, files): if passFail == 'pass': if _expect_pass(way): + t.expected_passes.append((directory, name, way)) t.n_expected_passes += 1 else: if_verbose(1, '*** unexpected pass for %s' % full_name) @@ -948,8 +956,9 @@ def ghci_script( name, way, script): # We pass HC and HC_OPTS as environment variables, so that the # script can invoke the correct compiler by using ':! $HC $HC_OPTS' - cmd = ('HC={{compiler}} HC_OPTS="{flags}" {{compiler}} {flags} {way_flags}' + cmd = ('HC={{compiler}} HC_OPTS="{flags}" {{compiler}} {way_flags} {flags}' ).format(flags=flags, way_flags=way_flags) + # NB: put way_flags before flags so that flags in all.T can overrie others getTestOpts().stdin = script return simple_run( name, way, cmd, getTestOpts().extra_run_opts ) @@ -964,19 +973,19 @@ def compile_fail( name, way, extra_hc_opts ): return do_compile( name, way, 1, '', [], extra_hc_opts ) def backpack_typecheck( name, way, extra_hc_opts ): - return do_compile( name, way, 0, '', [], "-fno-code -fwrite-interface " + extra_hc_opts, backpack=1 ) + return do_compile( name, way, 0, '', [], "-fno-code -fwrite-interface " + extra_hc_opts, backpack=True ) def backpack_typecheck_fail( name, way, extra_hc_opts ): - return do_compile( name, way, 1, '', [], "-fno-code -fwrite-interface " + extra_hc_opts, backpack=1 ) + return do_compile( name, way, 1, '', [], "-fno-code -fwrite-interface " + extra_hc_opts, backpack=True ) def backpack_compile( name, way, extra_hc_opts ): - return do_compile( name, way, 0, '', [], extra_hc_opts, backpack=1 ) + return do_compile( name, way, 0, '', [], extra_hc_opts, backpack=True ) def backpack_compile_fail( name, way, extra_hc_opts ): - return do_compile( name, way, 1, '', [], extra_hc_opts, backpack=1 ) + return do_compile( name, way, 1, '', [], extra_hc_opts, backpack=True ) def backpack_run( name, way, extra_hc_opts ): - return compile_and_run__( name, way, '', [], extra_hc_opts, backpack=1 ) + return compile_and_run__( name, way, '', [], extra_hc_opts, backpack=True ) def multimod_compile( name, way, top_mod, extra_hc_opts ): return do_compile( name, way, 0, top_mod, [], extra_hc_opts ) @@ -1206,7 +1215,7 @@ def simple_build(name, way, extra_hc_opts, should_fail, top_mod, link, addsuf, b if config.verbose >= 1 and _expect_pass(way): print('Compile failed (exit code {0}) errors were:'.format(exit_code)) actual_stderr_path = in_testdir(name, 'comp.stderr') - if_verbose_dump(1, actual_stderr_path) + dump_file(actual_stderr_path) # ToDo: if the sub-shell was killed by ^C, then exit @@ -1415,7 +1424,7 @@ def stdout_ok(name, way): expected_stdout_file, actual_stdout_file) def dump_stdout( name ): - with open(in_testdir(name, 'run.stdout')) as f: + with open(in_testdir(name, 'run.stdout'), encoding='utf8') as f: str = f.read().strip() if str: print("Stdout (", name, "):") @@ -1431,7 +1440,7 @@ def stderr_ok(name, way): whitespace_normaliser=normalise_whitespace) def dump_stderr( name ): - with open(in_testdir(name, 'run.stderr')) as f: + with open(in_testdir(name, 'run.stderr'), encoding='utf8') as f: str = f.read().strip() if str: print("Stderr (", name, "):") @@ -1553,7 +1562,7 @@ def compare_outputs(way, kind, normaliser, expected_file, actual_file, # See Note [Output comparison]. if whitespace_normaliser(expected_str) == whitespace_normaliser(actual_str): - return 1 + return True else: if config.verbose >= 1 and _expect_pass(way): print('Actual ' + kind + ' output differs from expected:') @@ -1568,29 +1577,39 @@ def compare_outputs(way, kind, normaliser, expected_file, actual_file, # See Note [Output comparison]. r = runCmd('diff -uw "{0}" "{1}"'.format(expected_normalised_path, actual_normalised_path), - print_output = 1) + print_output=True) # If for some reason there were no non-whitespace differences, # then do a full diff if r == 0: r = runCmd('diff -u "{0}" "{1}"'.format(expected_normalised_path, actual_normalised_path), - print_output = 1) + print_output=True) if config.accept and (getTestOpts().expect == 'fail' or way in getTestOpts().expect_fail_for): if_verbose(1, 'Test is expected to fail. Not accepting new output.') - return 0 + return False elif config.accept and actual_raw: - if_verbose(1, 'Accepting new output.') + if config.accept_platform: + if_verbose(1, 'Accepting new output for platform "' + + config.platform + '".') + expected_path += '-' + config.platform + elif config.accept_os: + if_verbose(1, 'Accepting new output for os "' + + config.os + '".') + expected_path += '-' + config.os + else: + if_verbose(1, 'Accepting new output.') + write_file(expected_path, actual_raw) - return 1 + return True elif config.accept: if_verbose(1, 'No output. Deleting "{0}".'.format(expected_path)) os.remove(expected_path) - return 1 + return True else: - return 0 + return False # Note [Output comparison] # @@ -1610,7 +1629,7 @@ def compare_outputs(way, kind, normaliser, expected_file, actual_file, def normalise_whitespace( str ): # Merge contiguous whitespace characters into a single space. - return ' '.join(w for w in str.split()) + return ' '.join(str.split()) callSite_re = re.compile(r', called at (.+):[\d]+:[\d]+ in [\w\-\.]+:') @@ -1730,6 +1749,7 @@ def normalise_prof (str): def normalise_slashes_( str ): str = re.sub('\\\\', '/', str) + str = re.sub('//', '/', str) return str def normalise_exe_( str ): @@ -1773,15 +1793,14 @@ def if_verbose( n, s ): if config.verbose >= n: print(s) -def if_verbose_dump( n, f ): - if config.verbose >= n: - try: - with io.open(f) as file: - print(file.read()) - except Exception: - print('') +def dump_file(f): + try: + with io.open(f) as file: + print(file.read()) + except Exception: + print('') -def runCmd(cmd, stdin=None, stdout=None, stderr=None, timeout_multiplier=1.0, print_output=0): +def runCmd(cmd, stdin=None, stdout=None, stderr=None, timeout_multiplier=1.0, print_output=False): timeout_prog = strip_quotes(config.timeout_prog) timeout = str(int(ceil(config.timeout * timeout_multiplier))) @@ -1789,9 +1808,6 @@ def runCmd(cmd, stdin=None, stdout=None, stderr=None, timeout_multiplier=1.0, pr cmd = cmd.format(**config.__dict__) if_verbose(3, cmd + ('< ' + os.path.basename(stdin) if stdin else '')) - # declare the buffers to a default - stdin_buffer = None - stdin_file = io.open(stdin, 'rb') if stdin else None stdout_buffer = b'' stderr_buffer = b'' @@ -1809,13 +1825,14 @@ def runCmd(cmd, stdin=None, stdout=None, stderr=None, timeout_multiplier=1.0, pr r = subprocess.Popen([timeout_prog, timeout, cmd], stdin=stdin_file, stdout=subprocess.PIPE, - stderr=hStdErr) + stderr=hStdErr, + env=ghc_env) stdout_buffer, stderr_buffer = r.communicate() finally: if stdin_file: stdin_file.close() - if config.verbose >= 1 and print_output >= 1: + if config.verbose >= 1 and print_output: if stdout_buffer: sys.stdout.buffer.write(stdout_buffer) if stderr_buffer: @@ -1848,7 +1865,7 @@ def gsNotWorking(): print("GhostScript not available for hp2ps tests") global gs_working -gs_working = 0 +gs_working = False if config.have_profiling: if config.gs != '': resultGood = runCmd(genGSCmd(config.confdir + '/good.ps')); @@ -1857,7 +1874,7 @@ if config.have_profiling: ' >/dev/null 2>&1') if resultBad != 0: print("GhostScript available for hp2ps tests") - gs_working = 1; + gs_working = True else: gsNotWorking(); else: @@ -1897,7 +1914,7 @@ def in_srcdir(name, suffix=''): # Finding the sample output. The filename is of the form # -# <test>.stdout[-ws-<wordsize>][-<platform>] +# <test>.stdout[-ws-<wordsize>][-<platform>|-<os>] # def find_expected_file(name, suff): basename = add_suffix(name, suff) @@ -1914,7 +1931,6 @@ def find_expected_file(name, suff): if config.msys: import stat - import time def cleanup(): testdir = getTestOpts().testdir max_attempts = 5 @@ -1968,7 +1984,7 @@ def findTFiles(roots): for root in roots: for path, dirs, files in os.walk(root, topdown=True): # Never pick up .T files in uncleaned .run directories. - dirs[:] = [dir for dir in sorted(dirs) + dirs[:] = [dir for dir in sorted(dirs) if not dir.endswith(testdir_suffix)] for filename in files: if filename.endswith('.T'): diff --git a/testsuite/driver/testutil.py b/testsuite/driver/testutil.py index dcba1777d1..15587e6960 100644 --- a/testsuite/driver/testutil.py +++ b/testsuite/driver/testutil.py @@ -1,4 +1,3 @@ -import errno import os import platform import subprocess @@ -11,8 +10,7 @@ def strip_quotes(s): return s.strip('\'"') def getStdout(cmd_and_args): - # Can't use subprocess.check_output as it's not available in Python 2.6; - # It's also not quite the same as check_output, since we also verify that + # Can't use subprocess.check_output, since we also verify that # no stderr was produced p = subprocess.Popen([strip_quotes(cmd_and_args[0])] + cmd_and_args[1:], stdout=subprocess.PIPE, @@ -23,16 +21,7 @@ def getStdout(cmd_and_args): raise Exception("Command failed: " + str(cmd_and_args)) if stderr: raise Exception("stderr from command: %s\nOutput:\n%s\n" % (cmd_and_args, stderr)) - return stdout - -def mkdirp(path): - try: - os.makedirs(path) - except OSError as e: - if e.errno == errno.EEXIST and os.path.isdir(path): - pass - else: - raise + return stdout.decode('utf-8') def lndir(srcdir, dstdir): # Create symlinks for all files in src directory. @@ -60,10 +49,6 @@ else: link_or_copy_file = os.symlink class Watcher(object): - global pool - global evt - global sync_lock - def __init__(self, count): self.pool = count self.evt = threading.Event() diff --git a/testsuite/mk/boilerplate.mk b/testsuite/mk/boilerplate.mk index 0b684c7195..4c32f30ee2 100644 --- a/testsuite/mk/boilerplate.mk +++ b/testsuite/mk/boilerplate.mk @@ -54,7 +54,7 @@ ifeq "$(TEST_HC)" "" # Tests should be able to handle paths with spaces. # # One of the things ./validate (without --fast) does is check if binary -# distributions can succesfully be installed and used in paths containing +# distributions can successfully be installed and used in paths containing # spaces. # # It does so in the following way: @@ -219,8 +219,14 @@ CP = cp RM = rm -f PYTHON = python3 +ifeq "$(CHECK_API_ANNOTATIONS)" "" CHECK_API_ANNOTATIONS := $(abspath $(TOP)/../inplace/bin/check-api-annotations) -CHECK_PPR := $(abspath $(TOP)/../inplace/bin/check-ppr) +endif + +ifeq "$(CHECK_PPR)" "" +CHECK_PPR := $(abspath $(TOP)/../inplace/bin/check-ppr) +endif + # ----------------------------------------------------------------------------- # configuration of TEST_HC diff --git a/testsuite/mk/ghc-config.hs b/testsuite/mk/ghc-config.hs index cf550082db..b0278bcfae 100644 --- a/testsuite/mk/ghc-config.hs +++ b/testsuite/mk/ghc-config.hs @@ -27,6 +27,7 @@ main = do getGhcFieldOrDefault fields "GhcDynamic" "GHC Dynamic" "NO" getGhcFieldOrDefault fields "GhcProfiled" "GHC Profiled" "NO" getGhcFieldProgWithDefault fields "AR" "ar command" "ar" + getGhcFieldProgWithDefault fields "CLANG" "LLVM clang command" "clang" getGhcFieldProgWithDefault fields "LLC" "LLVM llc command" "llc" getGhcFieldProgWithDefault fields "TEST_CC" "C compiler command" "gcc" diff --git a/testsuite/mk/test.mk b/testsuite/mk/test.mk index a44e200d49..d9a13aa711 100644 --- a/testsuite/mk/test.mk +++ b/testsuite/mk/test.mk @@ -14,6 +14,9 @@ # CONFIG -- use a different configuration file # COMPILER -- select a configuration file from config/ # THREADS -- run n tests at once +# PLATFORM -- if accepting a result, accept it for the current platform. +# OS -- if accepting a result, accept it for all wordsizes of the +# current os. # # ----------------------------------------------------------------------------- @@ -73,20 +76,22 @@ else dllext = .so endif -RUNTEST_OPTS += -e ghc_compiler_always_flags="'$(TEST_HC_OPTS)'" +RUNTEST_OPTS += -e "ghc_compiler_always_flags='$(TEST_HC_OPTS)'" RUNTEST_OPTS += -e config.compiler_debugged=$(GhcDebugged) ifeq "$(GhcWithNativeCodeGen)" "YES" -RUNTEST_OPTS += -e ghc_with_native_codegen=1 +RUNTEST_OPTS += -e ghc_with_native_codegen=True else -RUNTEST_OPTS += -e ghc_with_native_codegen=0 +RUNTEST_OPTS += -e ghc_with_native_codegen=False endif GHC_PRIM_LIBDIR := $(subst library-dirs: ,,$(shell "$(GHC_PKG)" field ghc-prim library-dirs --simple-output)) HAVE_VANILLA := $(shell if [ -f $(subst \,/,$(GHC_PRIM_LIBDIR))/GHC/PrimopWrappers.hi ]; then echo YES; else echo NO; fi) HAVE_DYNAMIC := $(shell if [ -f $(subst \,/,$(GHC_PRIM_LIBDIR))/GHC/PrimopWrappers.dyn_hi ]; then echo YES; else echo NO; fi) HAVE_PROFILING := $(shell if [ -f $(subst \,/,$(GHC_PRIM_LIBDIR))/GHC/PrimopWrappers.p_hi ]; then echo YES; else echo NO; fi) +HAVE_GDB := $(shell if gdb --version > /dev/null 2> /dev/null; then echo YES; else echo NO; fi) +HAVE_READELF := $(shell if readelf --version > /dev/null 2> /dev/null; then echo YES; else echo NO; fi) ifeq "$(HAVE_VANILLA)" "YES" RUNTEST_OPTS += -e config.have_vanilla=True @@ -107,15 +112,15 @@ RUNTEST_OPTS += -e config.have_profiling=False endif ifeq "$(filter thr, $(GhcRTSWays))" "thr" -RUNTEST_OPTS += -e ghc_with_threaded_rts=1 +RUNTEST_OPTS += -e ghc_with_threaded_rts=True else -RUNTEST_OPTS += -e ghc_with_threaded_rts=0 +RUNTEST_OPTS += -e ghc_with_threaded_rts=False endif ifeq "$(filter dyn, $(GhcRTSWays))" "dyn" -RUNTEST_OPTS += -e ghc_with_dynamic_rts=1 +RUNTEST_OPTS += -e ghc_with_dynamic_rts=True else -RUNTEST_OPTS += -e ghc_with_dynamic_rts=0 +RUNTEST_OPTS += -e ghc_with_dynamic_rts=False endif ifeq "$(GhcWithInterpreter)" "NO" @@ -132,6 +137,18 @@ else RUNTEST_OPTS += -e config.unregisterised=False endif +ifeq "$(HAVE_GDB)" "YES" +RUNTEST_OPTS += -e config.have_gdb=True +else +RUNTEST_OPTS += -e config.have_gdb=False +endif + +ifeq "$(HAVE_READELF)" "YES" +RUNTEST_OPTS += -e config.have_readelf=True +else +RUNTEST_OPTS += -e config.have_readelf=False +endif + ifeq "$(GhcDynamicByDefault)" "YES" RUNTEST_OPTS += -e config.ghc_dynamic_by_default=True CABAL_MINIMAL_BUILD = --enable-shared --disable-library-vanilla @@ -149,20 +166,20 @@ CABAL_PLUGIN_BUILD = --enable-library-vanilla --disable-shared endif ifeq "$(GhcWithSMP)" "YES" -RUNTEST_OPTS += -e ghc_with_smp=1 +RUNTEST_OPTS += -e ghc_with_smp=True else -RUNTEST_OPTS += -e ghc_with_smp=0 +RUNTEST_OPTS += -e ghc_with_smp=False endif ifeq "$(LLC)" "" -RUNTEST_OPTS += -e ghc_with_llvm=0 +RUNTEST_OPTS += -e ghc_with_llvm=False else ifeq "$(TargetARCH_CPP)" "powerpc" -RUNTEST_OPTS += -e ghc_with_llvm=0 +RUNTEST_OPTS += -e ghc_with_llvm=False else ifneq "$(LLC)" "llc" # If we have a real detected value for LLVM, then it really ought to work -RUNTEST_OPTS += -e ghc_with_llvm=1 +RUNTEST_OPTS += -e ghc_with_llvm=True else -RUNTEST_OPTS += -e ghc_with_llvm=0 +RUNTEST_OPTS += -e ghc_with_llvm=False endif ifeq "$(WINDOWS)" "YES" @@ -214,7 +231,7 @@ endif RUNTEST_OPTS += \ --rootdir=. \ - --configfile=$(CONFIG) \ + --config-file=$(CONFIG) \ -e 'config.confdir="$(CONFIGDIR)"' \ -e 'config.platform="$(TARGETPLATFORM)"' \ -e 'config.os="$(TargetOS_CPP)"' \ @@ -246,13 +263,17 @@ RUNTEST_OPTS += \ RUNTEST_OPTS += -e "config.stage=$(GhcStage)" +ifneq "$(JUNIT_FILE)" "" +RUNTEST_OPTS += \ + --junit "$(JUNIT_FILE)" +endif ifneq "$(SUMMARY_FILE)" "" RUNTEST_OPTS += \ --summary-file "$(SUMMARY_FILE)" endif ifeq "$(NO_PRINT_SUMMARY)" "YES" RUNTEST_OPTS += \ - --no-print-summary 1 + --no-print-summary endif RUNTEST_OPTS += \ @@ -275,7 +296,16 @@ setspeed = endif ifeq "$(accept)" "YES" -setaccept = -e config.accept=1 +setaccept = -e config.accept=True + +ifeq "$(PLATFORM)" "YES" +setaccept += -e config.accept_platform=True +endif + +ifeq "$(OS)" "YES" +setaccept += -e config.accept_os=True +endif + else setaccept = endif diff --git a/testsuite/tests/ado/T13242a.stderr b/testsuite/tests/ado/T13242a.stderr index dc4564f168..f31307df50 100644 --- a/testsuite/tests/ado/T13242a.stderr +++ b/testsuite/tests/ado/T13242a.stderr @@ -1,11 +1,10 @@ T13242a.hs:10:5: error: • Couldn't match expected type ‘a0’ with actual type ‘a’ - because type variable ‘a’ would escape its scope - This (rigid, skolem) type variable is bound by + ‘a’ is a rigid type variable bound by a pattern with constructor: A :: forall a. Eq a => a -> T, in a pattern binding in - 'do' block + a 'do' block at T13242a.hs:10:3-5 • In the expression: do A x <- undefined @@ -28,10 +27,10 @@ T13242a.hs:13:11: error: These potential instances exist: instance Eq Ordering -- Defined in ‘GHC.Classes’ instance Eq Integer - -- Defined in ‘integer-gmp-1.0.0.1:GHC.Integer.Type’ - instance Eq a => Eq (Maybe a) -- Defined in ‘GHC.Base’ - ...plus 22 others - ...plus five instances involving out-of-scope types + -- Defined in ‘integer-gmp-1.0.2.0:GHC.Integer.Type’ + instance Eq () -- Defined in ‘GHC.Classes’ + ...plus 21 others + ...plus six instances involving out-of-scope types (use -fprint-potential-instances to see them all) • In a stmt of a 'do' block: return (x == x) In the expression: diff --git a/testsuite/tests/ado/T14163.hs b/testsuite/tests/ado/T14163.hs new file mode 100644 index 0000000000..9463c1c5fc --- /dev/null +++ b/testsuite/tests/ado/T14163.hs @@ -0,0 +1,13 @@ +{-# language ApplicativeDo #-} + +import GHC.Exts + +readIt :: IO (Int, Int) +readIt = readLn + +main :: IO () +main = do + (_, _) <- readIt + (_, _) <- readIt + (_, _) <- readIt + print "Done" diff --git a/testsuite/tests/ado/T14163.stdin b/testsuite/tests/ado/T14163.stdin new file mode 100644 index 0000000000..0f620463b5 --- /dev/null +++ b/testsuite/tests/ado/T14163.stdin @@ -0,0 +1,3 @@ +(1,2) +(3,4) +(5,6) diff --git a/testsuite/tests/ado/T14163.stdout b/testsuite/tests/ado/T14163.stdout new file mode 100644 index 0000000000..5a32621be4 --- /dev/null +++ b/testsuite/tests/ado/T14163.stdout @@ -0,0 +1 @@ +"Done" diff --git a/testsuite/tests/ado/ado-optimal.hs b/testsuite/tests/ado/ado-optimal.hs index d67aa4fb1a..5e3266e8c2 100644 --- a/testsuite/tests/ado/ado-optimal.hs +++ b/testsuite/tests/ado/ado-optimal.hs @@ -3,7 +3,7 @@ module Main where import Control.Applicative -import Text.PrettyPrint +import Text.PrettyPrint as PP (a:b:c:d:e:f:g:h:_) = map (\c -> doc [c]) ['a'..] @@ -64,7 +64,7 @@ instance Monad M where (Nothing,Nothing) -> (Nothing, b) (Just d, Nothing) -> (Just d, b) (Nothing, Just d) -> (Just d, b) - (Just d1, Just d2) -> (Just (maybeParen p (d1 <> semi <+> d2)), b) + (Just d1, Just d2) -> (Just (maybeParen p (d1 PP.<> semi <+> d2)), b) doc :: String -> M () doc d = M $ \_ -> (Just (text d), ()) diff --git a/testsuite/tests/ado/ado001.hs b/testsuite/tests/ado/ado001.hs index 0d466c5fd1..6abce177e0 100644 --- a/testsuite/tests/ado/ado001.hs +++ b/testsuite/tests/ado/ado001.hs @@ -2,7 +2,7 @@ module Main where import Control.Applicative -import Text.PrettyPrint +import Text.PrettyPrint as PP (a:b:c:d:e:f:g:h:_) = map (\c -> doc [c]) ['a'..] @@ -175,7 +175,7 @@ instance Monad M where (Nothing,Nothing) -> (Nothing, b) (Just d, Nothing) -> (Just d, b) (Nothing, Just d) -> (Just d, b) - (Just d1, Just d2) -> (Just (maybeParen p (d1 <> semi <+> d2)), b) + (Just d1, Just d2) -> (Just (maybeParen p (d1 PP.<> semi <+> d2)), b) doc :: String -> M () doc d = M $ \_ -> (Just (text d), ()) diff --git a/testsuite/tests/ado/ado004.hs b/testsuite/tests/ado/ado004.hs index fa3c7231de..e7166c008e 100644 --- a/testsuite/tests/ado/ado004.hs +++ b/testsuite/tests/ado/ado004.hs @@ -16,6 +16,19 @@ test1a f = do y <- f 4 return $ x + y +-- When one of the statements is a BodyStmt +test1b :: Applicative f => (Int -> f Int) -> f Int +test1b f = do + x <- f 3 + f 4 + return x + +test1c :: Applicative f => (Int -> f Int) -> f Int +test1c f = do + f 3 + x <- f 4 + return x + -- Test we can also infer the Applicative version of the type test2 f = do x <- f 3 @@ -32,6 +45,11 @@ test2c f = do x <- f 3 return $ x + 1 +-- with a BodyStmt +test2d f = do + f 3 + return 4 + -- Test for just one statement test2b f = do return (f 3) diff --git a/testsuite/tests/ado/ado004.stderr b/testsuite/tests/ado/ado004.stderr index 726309d49a..c0f7838b08 100644 --- a/testsuite/tests/ado/ado004.stderr +++ b/testsuite/tests/ado/ado004.stderr @@ -3,38 +3,46 @@ TYPE SIGNATURES forall (f :: * -> *). Applicative f => (Int -> f Int) -> f Int test1a :: forall (f :: * -> *). Applicative f => (Int -> f Int) -> f Int + test1b :: + forall (f :: * -> *). Applicative f => (Int -> f Int) -> f Int + test1c :: + forall (f :: * -> *). Applicative f => (Int -> f Int) -> f Int test2 :: forall (f :: * -> *) t b. - (Num b, Num t, Applicative f) => + (Applicative f, Num t, Num b) => (t -> f b) -> f b test2a :: forall (f :: * -> *) t b. - (Num b, Num t, Functor f) => + (Functor f, Num t, Num b) => (t -> f b) -> f b test2b :: - forall (m :: * -> *) t a. (Num t, Monad m) => (t -> a) -> m a + forall (m :: * -> *) t a. (Monad m, Num t) => (t -> a) -> m a test2c :: forall (f :: * -> *) t b. - (Num b, Num t, Functor f) => + (Functor f, Num t, Num b) => (t -> f b) -> f b + test2d :: + forall (f :: * -> *) t1 b t2. + (Functor f, Num t1, Num b) => + (t1 -> f t2) -> f b test3 :: forall (m :: * -> *) t1 t2 a. - (Num t1, Monad m) => + (Monad m, Num t1) => (t1 -> m t2) -> (t2 -> t2 -> m a) -> m a test4 :: forall (m :: * -> *) t a1 a2. - (Num t, Monad m) => + (Monad m, Num t) => (t -> m a1) -> (a1 -> a1 -> m a2) -> m a2 test5 :: forall (m :: * -> *) t a1 a2. - (Num t, Monad m) => + (Monad m, Num t) => (t -> m a1) -> (a1 -> a1 -> m a2) -> m a2 test6 :: forall (m :: * -> *) a p. - (Num (m a), Monad m) => + (Monad m, Num (m a)) => (m a -> m (m a)) -> p -> m a TYPE CONSTRUCTORS COERCION AXIOMS Dependent modules: [] -Dependent packages: [base-4.10.0.0, ghc-prim-0.5.1.0, - integer-gmp-1.0.0.1] +Dependent packages: [base-4.12.0.0, ghc-prim-0.5.3, + integer-gmp-1.0.2.0] diff --git a/testsuite/tests/ado/all.T b/testsuite/tests/ado/all.T index bb1cc163d1..d88e907315 100644 --- a/testsuite/tests/ado/all.T +++ b/testsuite/tests/ado/all.T @@ -11,3 +11,4 @@ test('T12490', normal, compile, ['']) test('T13242', normal, compile, ['']) test('T13242a', normal, compile_fail, ['']) test('T13875', normal, compile_and_run, ['']) +test('T14163', normal, compile_and_run, ['']) diff --git a/testsuite/tests/annotations/should_compile/T14129.hs b/testsuite/tests/annotations/should_compile/T14129.hs new file mode 100644 index 0000000000..131a29d3d9 --- /dev/null +++ b/testsuite/tests/annotations/should_compile/T14129.hs @@ -0,0 +1,3 @@ +module T14129 where + +{-# ANN module "KABOOM" #-} diff --git a/testsuite/tests/annotations/should_compile/all.T b/testsuite/tests/annotations/should_compile/all.T index b2c9a598c6..be81c4fc19 100644 --- a/testsuite/tests/annotations/should_compile/all.T +++ b/testsuite/tests/annotations/should_compile/all.T @@ -3,6 +3,7 @@ # program twice and use -osuf p_o (see the TH_spliceE5_prof test). For # now, just disable the profiling ways. test('ann01', [req_interp, omit_ways(prof_ways)], compile, ['-v0']) +test('T14129', [req_interp, omit_ways(prof_ways)], compile, ['-v0']) """" Helpful things to C+P: diff --git a/testsuite/tests/annotations/should_fail/annfail10.stderr b/testsuite/tests/annotations/should_fail/annfail10.stderr index 6329c38e6d..d29a861566 100644 --- a/testsuite/tests/annotations/should_fail/annfail10.stderr +++ b/testsuite/tests/annotations/should_fail/annfail10.stderr @@ -10,7 +10,7 @@ annfail10.hs:9:1: error: instance Data.Data.Data Ordering -- Defined in ‘Data.Data’ instance Data.Data.Data Integer -- Defined in ‘Data.Data’ ...plus 15 others - ...plus 42 instances involving out-of-scope types + ...plus 47 instances involving out-of-scope types (use -fprint-potential-instances to see them all) • In the annotation: {-# ANN f 1 #-} @@ -23,6 +23,6 @@ annfail10.hs:9:11: error: instance Num Double -- Defined in ‘GHC.Float’ instance Num Float -- Defined in ‘GHC.Float’ ...plus two others - ...plus 15 instances involving out-of-scope types + ...plus 19 instances involving out-of-scope types (use -fprint-potential-instances to see them all) • In the annotation: {-# ANN f 1 #-} diff --git a/testsuite/tests/annotations/should_run/annrun01.hs b/testsuite/tests/annotations/should_run/annrun01.hs index 0dbd44dd92..9030a39c60 100644 --- a/testsuite/tests/annotations/should_run/annrun01.hs +++ b/testsuite/tests/annotations/should_run/annrun01.hs @@ -4,6 +4,7 @@ module Main where import GHC import MonadUtils ( liftIO ) +import Data.Maybe import DynFlags ( defaultFatalMessager, defaultFlushOut ) import Annotations ( AnnTarget(..), CoreAnnTarget ) import GHC.Serialized ( deserializeWithData ) @@ -34,7 +35,7 @@ main = defaultErrorHandler defaultFatalMessager defaultFlushOut liftIO $ putStrLn "Finding Module" mod <- findModule mod_nm Nothing liftIO $ putStrLn "Getting Module Info" - Just mod_info <- getModuleInfo mod + mod_info <- fromJust <$> getModuleInfo mod liftIO $ putStrLn "Showing Details For Module" showTargetAnns (ModuleTarget mod) diff --git a/testsuite/tests/backpack/cabal/T14304/Makefile b/testsuite/tests/backpack/cabal/T14304/Makefile new file mode 100644 index 0000000000..6f2394ff47 --- /dev/null +++ b/testsuite/tests/backpack/cabal/T14304/Makefile @@ -0,0 +1,36 @@ +TOP=../../../.. +include $(TOP)/mk/boilerplate.mk +include $(TOP)/mk/test.mk + +SETUP='$(PWD)/Setup' -v0 +CONFIGURE=$(SETUP) configure $(CABAL_MINIMAL_BUILD) --with-ghc='$(TEST_HC)' --ghc-options='$(TEST_HC_OPTS)' --package-db='$(PWD)/tmp.d' --prefix='$(PWD)/inst' --enable-shared + +T14304: clean + $(MAKE) -s --no-print-directory clean + '$(GHC_PKG)' init tmp.d + '$(TEST_HC)' $(TEST_HC_OPTS) -v0 --make Setup + # typecheck indef + rm -rf indef/dist + (cd indef; $(CONFIGURE) --ipid "indef-0.1") + (cd indef; $(SETUP) build) + (cd indef; $(SETUP) copy) + (cd indef; $(SETUP) register) + # build p + rm -rf p/dist + (cd p; $(CONFIGURE) --ipid "p-0.1") + (cd p; $(SETUP) build) + (cd p; $(SETUP) copy) + (cd p; $(SETUP) register) + # build indef instantiated with p + rm -rf indef/dist + (cd indef; $(CONFIGURE) --ipid "indef-0.1" --instantiate-with "Sig=p-0.1:P") + (cd indef; $(SETUP) build) + (cd indef; $(SETUP) copy) + (cd indef; $(SETUP) register) + # build th (which tests if we have correct linkage) + rm -rf th/dist + (cd th; $(CONFIGURE)) + (cd th; $(SETUP) build) + +clean : + $(RM) -r tmp.d inst dist Setup$(exeext) diff --git a/testsuite/tests/backpack/cabal/T14304/Setup.hs b/testsuite/tests/backpack/cabal/T14304/Setup.hs new file mode 100644 index 0000000000..9a994af677 --- /dev/null +++ b/testsuite/tests/backpack/cabal/T14304/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/testsuite/tests/backpack/cabal/T14304/T14304.stderr b/testsuite/tests/backpack/cabal/T14304/T14304.stderr new file mode 100644 index 0000000000..89a07b9193 --- /dev/null +++ b/testsuite/tests/backpack/cabal/T14304/T14304.stderr @@ -0,0 +1,6 @@ +Warning: -rtsopts and -with-rtsopts have no effect with -shared. + Call hs_init_ghc() from your main() function to set these options. +Warning: -rtsopts and -with-rtsopts have no effect with -shared. + Call hs_init_ghc() from your main() function to set these options. +Warning: -rtsopts and -with-rtsopts have no effect with -shared. + Call hs_init_ghc() from your main() function to set these options. diff --git a/testsuite/tests/backpack/cabal/T14304/all.T b/testsuite/tests/backpack/cabal/T14304/all.T new file mode 100644 index 0000000000..cc121c0388 --- /dev/null +++ b/testsuite/tests/backpack/cabal/T14304/all.T @@ -0,0 +1,10 @@ +if config.cleanup: + cleanup = 'CLEANUP=1' +else: + cleanup = 'CLEANUP=0' + +test('T14304', + [extra_files(['p', 'indef', 'th', 'Setup.hs']), + unless(have_dynamic(), skip)], + run_command, + ['$MAKE -s --no-print-directory T14304 ' + cleanup]) diff --git a/testsuite/tests/backpack/cabal/T14304/indef/Indef.hs b/testsuite/tests/backpack/cabal/T14304/indef/Indef.hs new file mode 100644 index 0000000000..0bd438e6de --- /dev/null +++ b/testsuite/tests/backpack/cabal/T14304/indef/Indef.hs @@ -0,0 +1,3 @@ +module Indef where +import Sig +data T = MkT B diff --git a/testsuite/tests/backpack/cabal/T14304/indef/Sig.hsig b/testsuite/tests/backpack/cabal/T14304/indef/Sig.hsig new file mode 100644 index 0000000000..a37b1908bc --- /dev/null +++ b/testsuite/tests/backpack/cabal/T14304/indef/Sig.hsig @@ -0,0 +1,2 @@ +signature Sig where +data B diff --git a/testsuite/tests/backpack/cabal/T14304/indef/indef.cabal b/testsuite/tests/backpack/cabal/T14304/indef/indef.cabal new file mode 100644 index 0000000000..d89f055959 --- /dev/null +++ b/testsuite/tests/backpack/cabal/T14304/indef/indef.cabal @@ -0,0 +1,9 @@ +name: indef +version: 1.0 +build-type: Simple +cabal-version: >= 2.0 + +library + build-depends: base + signatures: Sig + exposed-modules: Indef diff --git a/testsuite/tests/backpack/cabal/T14304/p/P.hs b/testsuite/tests/backpack/cabal/T14304/p/P.hs new file mode 100644 index 0000000000..f570e0bb7f --- /dev/null +++ b/testsuite/tests/backpack/cabal/T14304/p/P.hs @@ -0,0 +1,3 @@ +module P where +type B = Foo +newtype Foo = Foo Double diff --git a/testsuite/tests/backpack/cabal/T14304/p/p.cabal b/testsuite/tests/backpack/cabal/T14304/p/p.cabal new file mode 100644 index 0000000000..f49ce4273f --- /dev/null +++ b/testsuite/tests/backpack/cabal/T14304/p/p.cabal @@ -0,0 +1,8 @@ +name: p +version: 1.0 +build-type: Simple +cabal-version: >= 2.0 + +library + build-depends: base + exposed-modules: P diff --git a/testsuite/tests/backpack/cabal/T14304/th/TH.hs b/testsuite/tests/backpack/cabal/T14304/th/TH.hs new file mode 100644 index 0000000000..5d921cf931 --- /dev/null +++ b/testsuite/tests/backpack/cabal/T14304/th/TH.hs @@ -0,0 +1,3 @@ +{-# LANGUAGE TemplateHaskell #-} +module TH where +$( return [] ) diff --git a/testsuite/tests/backpack/cabal/T14304/th/th.cabal b/testsuite/tests/backpack/cabal/T14304/th/th.cabal new file mode 100644 index 0000000000..2b17f09493 --- /dev/null +++ b/testsuite/tests/backpack/cabal/T14304/th/th.cabal @@ -0,0 +1,9 @@ +name: th +version: 1.0 +build-type: Simple +cabal-version: >= 2.0 + +library + build-depends: p, indef, base + mixins: p (P as Sig) + exposed-modules: TH diff --git a/testsuite/tests/backpack/cabal/bkpcabal01/Makefile b/testsuite/tests/backpack/cabal/bkpcabal01/Makefile index e67707f645..01744dae01 100644 --- a/testsuite/tests/backpack/cabal/bkpcabal01/Makefile +++ b/testsuite/tests/backpack/cabal/bkpcabal01/Makefile @@ -8,7 +8,7 @@ CONFIGURE=$(SETUP) configure $(CABAL_MINIMAL_BUILD) --with-ghc='$(TEST_HC)' --gh bkpcabal01: clean $(MAKE) -s --no-print-directory clean '$(GHC_PKG)' init tmp.d - '$(TEST_HC)' -v0 --make Setup + '$(TEST_HC)' $(TEST_HC_OPTS) -v0 --make Setup cp p/P.hs.in1 p/P.hs cp q/Q.hs.in1 q/Q.hs # typecheck p diff --git a/testsuite/tests/backpack/cabal/bkpcabal01/all.T b/testsuite/tests/backpack/cabal/bkpcabal01/all.T index e470708b23..1b72bd2f70 100644 --- a/testsuite/tests/backpack/cabal/bkpcabal01/all.T +++ b/testsuite/tests/backpack/cabal/bkpcabal01/all.T @@ -4,6 +4,7 @@ else: cleanup = 'CLEANUP=0' test('bkpcabal01', - extra_files(['p', 'q', 'impl', 'bkpcabal01.cabal', 'Setup.hs', 'Main.hs']), + [extra_files(['p', 'q', 'impl', 'bkpcabal01.cabal', 'Setup.hs', 'Main.hs']), + run_timeout_multiplier(2)], run_command, ['$MAKE -s --no-print-directory bkpcabal01 ' + cleanup]) diff --git a/testsuite/tests/backpack/cabal/bkpcabal01/p/P.hs.in1 b/testsuite/tests/backpack/cabal/bkpcabal01/p/P.hs.in1 index 327a032132..875c370915 100644 --- a/testsuite/tests/backpack/cabal/bkpcabal01/p/P.hs.in1 +++ b/testsuite/tests/backpack/cabal/bkpcabal01/p/P.hs.in1 @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} module P where import H y = x diff --git a/testsuite/tests/backpack/cabal/bkpcabal02/Makefile b/testsuite/tests/backpack/cabal/bkpcabal02/Makefile index 4856c2ca5b..3fd073ac1c 100644 --- a/testsuite/tests/backpack/cabal/bkpcabal02/Makefile +++ b/testsuite/tests/backpack/cabal/bkpcabal02/Makefile @@ -8,7 +8,7 @@ CONFIGURE=$(SETUP) configure $(CABAL_MINIMAL_BUILD) --with-ghc='$(TEST_HC)' --gh bkpcabal02: clean $(MAKE) -s --no-print-directory clean '$(GHC_PKG)' init tmp.d - '$(TEST_HC)' -v0 --make Setup + '$(TEST_HC)' $(TEST_HC_OPTS) -v0 --make Setup # Here is a working signature which this # package can typecheck with cp p/H.hsig.in1 p/H.hsig diff --git a/testsuite/tests/backpack/cabal/bkpcabal03/Makefile b/testsuite/tests/backpack/cabal/bkpcabal03/Makefile index d5c39e4a21..5521264ead 100644 --- a/testsuite/tests/backpack/cabal/bkpcabal03/Makefile +++ b/testsuite/tests/backpack/cabal/bkpcabal03/Makefile @@ -8,7 +8,7 @@ CONFIGURE=$(SETUP) configure $(CABAL_MINIMAL_BUILD) --with-ghc='$(TEST_HC)' --gh bkpcabal03: clean $(MAKE) -s --no-print-directory clean '$(GHC_PKG)' init tmp.d - '$(TEST_HC)' -v0 --make Setup + '$(TEST_HC)' $(TEST_HC_OPTS) -v0 --make Setup cp bkpcabal03.cabal.in1 bkpcabal03.cabal # typecheck asig1 (cd asig1; $(CONFIGURE) --cid "asig1" asig1) diff --git a/testsuite/tests/backpack/cabal/bkpcabal04/Makefile b/testsuite/tests/backpack/cabal/bkpcabal04/Makefile index 0e81107d9e..dd50e61bd4 100644 --- a/testsuite/tests/backpack/cabal/bkpcabal04/Makefile +++ b/testsuite/tests/backpack/cabal/bkpcabal04/Makefile @@ -8,7 +8,7 @@ CONFIGURE=$(SETUP) configure $(CABAL_MINIMAL_BUILD) --with-ghc='$(TEST_HC)' --gh bkpcabal04: clean $(MAKE) -s --no-print-directory clean '$(GHC_PKG)' init tmp.d - '$(TEST_HC)' -v0 --make Setup + '$(TEST_HC)' $(TEST_HC_OPTS) -v0 --make Setup cp bkpcabal04.cabal.in1 bkpcabal04.cabal cp q/B.hsig.in q/B.hsig # typecheck diff --git a/testsuite/tests/backpack/cabal/bkpcabal05/Makefile b/testsuite/tests/backpack/cabal/bkpcabal05/Makefile index b5a7fa5db1..0679feee6a 100644 --- a/testsuite/tests/backpack/cabal/bkpcabal05/Makefile +++ b/testsuite/tests/backpack/cabal/bkpcabal05/Makefile @@ -12,7 +12,7 @@ CONFIGURE=$(SETUP) configure $(CABAL_MINIMAL_BUILD) --with-ghc='$(TEST_HC)' --gh bkpcabal05: clean $(MAKE) -s --no-print-directory clean '$(GHC_PKG)' init tmp.d - '$(TEST_HC)' -v0 --make Setup + '$(TEST_HC)' $(TEST_HC_OPTS) -v0 --make Setup $(CONFIGURE) cp A.hsig.in1 A.hsig # typecheck diff --git a/testsuite/tests/backpack/cabal/bkpcabal06/Makefile b/testsuite/tests/backpack/cabal/bkpcabal06/Makefile index 29f1456e63..aa379dc2c4 100644 --- a/testsuite/tests/backpack/cabal/bkpcabal06/Makefile +++ b/testsuite/tests/backpack/cabal/bkpcabal06/Makefile @@ -12,7 +12,7 @@ CONFIGURE=$(SETUP) configure $(CABAL_MINIMAL_BUILD) --with-ghc='$(TEST_HC)' --gh bkpcabal06: clean $(MAKE) -s --no-print-directory clean '$(GHC_PKG)' init tmp.d - '$(TEST_HC)' -v0 --make Setup + '$(TEST_HC)' $(TEST_HC_OPTS) -v0 --make Setup $(CONFIGURE) cp impl/P.hs.in1 impl/P.hs $(SETUP) build diff --git a/testsuite/tests/backpack/cabal/bkpcabal06/all.T b/testsuite/tests/backpack/cabal/bkpcabal06/all.T index 26db90c976..40ad858aee 100644 --- a/testsuite/tests/backpack/cabal/bkpcabal06/all.T +++ b/testsuite/tests/backpack/cabal/bkpcabal06/all.T @@ -4,6 +4,7 @@ else: cleanup = 'CLEANUP=0' test('bkpcabal06', - extra_files(['bkpcabal06.cabal', 'Setup.hs', 'sig', 'impl']), + [extra_files(['bkpcabal06.cabal', 'Setup.hs', 'sig', 'impl']), + when(opsys('mingw32'), skip)], run_command, ['$MAKE -s --no-print-directory bkpcabal06 ' + cleanup]) diff --git a/testsuite/tests/backpack/cabal/bkpcabal06/bkpcabal06.cabal b/testsuite/tests/backpack/cabal/bkpcabal06/bkpcabal06.cabal index 7dfac20986..ff322a4e02 100644 --- a/testsuite/tests/backpack/cabal/bkpcabal06/bkpcabal06.cabal +++ b/testsuite/tests/backpack/cabal/bkpcabal06/bkpcabal06.cabal @@ -4,7 +4,7 @@ license: BSD3 author: Edward Z. Yang maintainer: ezyang@cs.stanford.edu build-type: Simple -cabal-version: >=1.10 +cabal-version: 2.0 library sig signatures: P diff --git a/testsuite/tests/backpack/cabal/bkpcabal07/Makefile b/testsuite/tests/backpack/cabal/bkpcabal07/Makefile index a83f4b9128..346ac32219 100644 --- a/testsuite/tests/backpack/cabal/bkpcabal07/Makefile +++ b/testsuite/tests/backpack/cabal/bkpcabal07/Makefile @@ -11,7 +11,7 @@ CONFIGURE=$(SETUP) configure $(CABAL_MINIMAL_BUILD) --with-ghc='$(TEST_HC)' --gh bkpcabal07: clean $(MAKE) -s --no-print-directory clean '$(GHC_PKG)' init tmp.d - '$(TEST_HC)' -v0 --make Setup + '$(TEST_HC)' $(TEST_HC_OPTS) -v0 --make Setup $(CONFIGURE) $(SETUP) build ifneq "$(CLEANUP)" "" diff --git a/testsuite/tests/backpack/cabal/bkpcabal07/all.T b/testsuite/tests/backpack/cabal/bkpcabal07/all.T index d449ab13e4..bd6e689a4b 100644 --- a/testsuite/tests/backpack/cabal/bkpcabal07/all.T +++ b/testsuite/tests/backpack/cabal/bkpcabal07/all.T @@ -4,6 +4,7 @@ else: cleanup = 'CLEANUP=0' test('bkpcabal07', - extra_files(['bkpcabal07.cabal', 'Setup.hs', 'M.hs', 'P.hsig']), + [extra_files(['bkpcabal07.cabal', 'Setup.hs', 'M.hs', 'P.hsig']), + when(opsys('mingw32'), skip)], run_command, ['$MAKE -s --no-print-directory bkpcabal07 ' + cleanup]) diff --git a/testsuite/tests/backpack/should_compile/bkp16.stderr b/testsuite/tests/backpack/should_compile/bkp16.stderr index 59ed676549..4a5f2d04d2 100644 --- a/testsuite/tests/backpack/should_compile/bkp16.stderr +++ b/testsuite/tests/backpack/should_compile/bkp16.stderr @@ -2,7 +2,7 @@ [1 of 1] Compiling Int[sig] ( p/Int.hsig, nothing ) [2 of 2] Processing q Instantiating q - [1 of 1] Including p[Int=base-4.10.0.0:GHC.Exts] - Instantiating p[Int=base-4.10.0.0:GHC.Exts] - [1 of 1] Including ghc-prim-0.5.1.0 + [1 of 1] Including p[Int=base-4.12.0.0:GHC.Exts] + Instantiating p[Int=base-4.12.0.0:GHC.Exts] + [1 of 1] Including ghc-prim-0.5.3 [1 of 1] Compiling Int[sig] ( p/Int.hsig, bkp16.out/p/p-97PZnzqiJmd2hTwUNGdjod/Int.o ) diff --git a/testsuite/tests/backpack/should_fail/bkpfail16.stderr b/testsuite/tests/backpack/should_fail/bkpfail16.stderr index bd7c229713..c893ebae35 100644 --- a/testsuite/tests/backpack/should_fail/bkpfail16.stderr +++ b/testsuite/tests/backpack/should_fail/bkpfail16.stderr @@ -2,8 +2,8 @@ [1 of 1] Compiling ShouldFail[sig] ( p/ShouldFail.hsig, nothing ) [2 of 2] Processing q Instantiating q - [1 of 1] Including p[ShouldFail=base-4.10.0.0:Data.Bool] - Instantiating p[ShouldFail=base-4.10.0.0:Data.Bool] + [1 of 1] Including p[ShouldFail=base-4.12.0.0:Data.Bool] + Instantiating p[ShouldFail=base-4.12.0.0:Data.Bool] [1 of 1] Compiling ShouldFail[sig] ( p/ShouldFail.hsig, bkpfail16.out/p/p-1OqLaT7dAn947wScQQKCw5/ShouldFail.o ) bkpfail16.out/p/p-1OqLaT7dAn947wScQQKCw5/../ShouldFail.hi:1:1: error: diff --git a/testsuite/tests/backpack/should_fail/bkpfail17.stderr b/testsuite/tests/backpack/should_fail/bkpfail17.stderr index 6d74b69652..02ee990c90 100644 --- a/testsuite/tests/backpack/should_fail/bkpfail17.stderr +++ b/testsuite/tests/backpack/should_fail/bkpfail17.stderr @@ -2,8 +2,8 @@ [1 of 1] Compiling ShouldFail[sig] ( p/ShouldFail.hsig, nothing ) [2 of 2] Processing q Instantiating q - [1 of 1] Including p[ShouldFail=base-4.10.0.0:Prelude] - Instantiating p[ShouldFail=base-4.10.0.0:Prelude] + [1 of 1] Including p[ShouldFail=base-4.12.0.0:Prelude] + Instantiating p[ShouldFail=base-4.12.0.0:Prelude] [1 of 1] Compiling ShouldFail[sig] ( p/ShouldFail.hsig, bkpfail17.out/p/p-2W6J7O3LvroH97zGxbPEGF/ShouldFail.o ) <no location info>: error: diff --git a/testsuite/tests/backpack/should_fail/bkpfail19.stderr b/testsuite/tests/backpack/should_fail/bkpfail19.stderr index aaf5b8ce27..03fdcd7d16 100644 --- a/testsuite/tests/backpack/should_fail/bkpfail19.stderr +++ b/testsuite/tests/backpack/should_fail/bkpfail19.stderr @@ -2,8 +2,8 @@ [1 of 1] Compiling ShouldFail[sig] ( p/ShouldFail.hsig, nothing ) [2 of 2] Processing q Instantiating q - [1 of 1] Including p[ShouldFail=base-4.10.0.0:Data.STRef] - Instantiating p[ShouldFail=base-4.10.0.0:Data.STRef] + [1 of 1] Including p[ShouldFail=base-4.12.0.0:Data.STRef] + Instantiating p[ShouldFail=base-4.12.0.0:Data.STRef] [1 of 1] Compiling ShouldFail[sig] ( p/ShouldFail.hsig, bkpfail19.out/p/p-CfyUIAu1JTRCDuXEyGszXN/ShouldFail.o ) <no location info>: error: diff --git a/testsuite/tests/backpack/should_fail/bkpfail48.stderr b/testsuite/tests/backpack/should_fail/bkpfail48.stderr index 9c991d6fc9..cb0740d8bf 100644 --- a/testsuite/tests/backpack/should_fail/bkpfail48.stderr +++ b/testsuite/tests/backpack/should_fail/bkpfail48.stderr @@ -4,7 +4,7 @@ [1 of 1] Compiling A[sig] ( p/A.hsig, nothing ) bkpfail48.bkp:6:18: error: - • The export item `module Data.Bool' is not imported + • The export item ‘module Data.Bool’ is not imported • while merging the signatures from: • q[A=<A>]:A • ...and the local signature for A diff --git a/testsuite/tests/backpack/should_run/T13955.bkp b/testsuite/tests/backpack/should_run/T13955.bkp new file mode 100644 index 0000000000..a7d447f169 --- /dev/null +++ b/testsuite/tests/backpack/should_run/T13955.bkp @@ -0,0 +1,44 @@ +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE TypeInType #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE DataKinds #-} + +unit number-unknown where + signature NumberUnknown where + import GHC.Types + data Rep :: RuntimeRep + data Number :: TYPE Rep + plus :: Number -> Number -> Number + multiply :: Number -> Number -> Number + module NumberStuff where + import NumberUnknown + funcA :: Number -> Number -> Number + funcA x y = plus x (multiply x y) + +unit number-int where + module NumberUnknown where + import GHC.Types + type Rep = LiftedRep + type Number = Int + plus :: Int -> Int -> Int + plus = (+) + multiply :: Int -> Int -> Int + multiply = (*) + +unit number-unboxed-int where + module NumberUnknown where + import GHC.Types + import GHC.Prim + type Rep = IntRep + type Number = Int# + plus :: Int# -> Int# -> Int# + plus = (+#) + multiply :: Int# -> Int# -> Int# + multiply = (*#) + +unit main where + dependency number-unknown[NumberUnknown=number-unboxed-int:NumberUnknown] + module Main where + import NumberStuff + import GHC.Types + main = print (I# (funcA 2# 3#)) diff --git a/testsuite/tests/backpack/should_run/T13955.stdout b/testsuite/tests/backpack/should_run/T13955.stdout new file mode 100644 index 0000000000..45a4fb75db --- /dev/null +++ b/testsuite/tests/backpack/should_run/T13955.stdout @@ -0,0 +1 @@ +8 diff --git a/testsuite/tests/backpack/should_run/T15138.bkp b/testsuite/tests/backpack/should_run/T15138.bkp new file mode 100644 index 0000000000..7cb9eeb804 --- /dev/null +++ b/testsuite/tests/backpack/should_run/T15138.bkp @@ -0,0 +1,36 @@ +{-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE FlexibleContexts #-} + +unit indef where + + signature Abstract where + import GHC.TypeLits + data NatType :: Nat + + module Util where + import Abstract + import Data.Proxy + import GHC.TypeLits + + natTypeToInteger :: KnownNat NatType => Proxy NatType -> Integer + natTypeToInteger = natVal + +unit concrete where + module Concrete where + type NatType = 32 + + +unit main where + dependency indef[Abstract=concrete:Concrete] (Util as MyUtil) + + module Main where + import Data.Proxy + import MyUtil + + main :: IO () + main = do print $ natTypeToInteger Proxy diff --git a/testsuite/tests/backpack/should_run/T15138.stdout b/testsuite/tests/backpack/should_run/T15138.stdout new file mode 100644 index 0000000000..f5c89552bd --- /dev/null +++ b/testsuite/tests/backpack/should_run/T15138.stdout @@ -0,0 +1 @@ +32 diff --git a/testsuite/tests/backpack/should_run/all.T b/testsuite/tests/backpack/should_run/all.T index b32560059b..61277b8f31 100644 --- a/testsuite/tests/backpack/should_run/all.T +++ b/testsuite/tests/backpack/should_run/all.T @@ -6,3 +6,6 @@ test('bkprun05', exit_code(1), backpack_run, ['']) test('bkprun06', normal, backpack_run, ['']) test('bkprun07', normal, backpack_run, ['']) test('bkprun08', normal, backpack_run, ['']) +test('bkprun09', normal, backpack_run, ['-O']) +test('T13955', normal, backpack_run, ['']) +test('T15138', normal, backpack_run, ['']) diff --git a/testsuite/tests/backpack/should_run/bkprun05.bkp b/testsuite/tests/backpack/should_run/bkprun05.bkp index 25c951e3ff..de2374f569 100644 --- a/testsuite/tests/backpack/should_run/bkprun05.bkp +++ b/testsuite/tests/backpack/should_run/bkprun05.bkp @@ -53,8 +53,8 @@ unit app where union :: Ord k => Map k a -> Map k a -> Map k a unionWith :: Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a unionWithKey :: Ord k => (k -> a -> a -> a) -> Map k a -> Map k a -> Map k a - unions :: Ord k => [Map k a] -> Map k a - unionsWith :: Ord k => (a -> a -> a) -> [Map k a] -> Map k a + unions :: (Foldable f, Ord k) => f (Map k a) -> Map k a + unionsWith :: (Foldable f, Ord k) => (a -> a -> a) -> f (Map k a) -> Map k a difference :: Ord k => Map k a -> Map k b -> Map k a differenceWith :: Ord k => (a -> b -> Maybe a) -> Map k a -> Map k b -> Map k a differenceWithKey :: Ord k => (k -> a -> b -> Maybe a) -> Map k a -> Map k b -> Map k a @@ -127,8 +127,6 @@ unit app where maxView :: Map k a -> Maybe (a, Map k a) minViewWithKey :: Map k a -> Maybe ((k, a), Map k a) maxViewWithKey :: Map k a -> Maybe ((k, a), Map k a) - showTree :: (Show k, Show a) => Map k a -> String - showTreeWith :: (k -> a -> String) -> Bool -> Bool -> Map k a -> String valid :: Ord k => Map k a -> Bool module App where import Map diff --git a/testsuite/tests/backpack/should_run/bkprun05.stderr b/testsuite/tests/backpack/should_run/bkprun05.stderr index 854de8b6c5..12d7d92d2d 100644 --- a/testsuite/tests/backpack/should_run/bkprun05.stderr +++ b/testsuite/tests/backpack/should_run/bkprun05.stderr @@ -1,4 +1,4 @@ bkprun05: Prelude.undefined CallStack (from HasCallStack): - error, called at libraries/base/GHC/Err.hs:79:14 in base:GHC.Err - undefined, called at bkprun05.bkp:138:30 in app+app-89WS9ScvjQd9lPG2oW0wWM:App + error, called at libraries/base/GHC/Err.hs:78:14 in base:GHC.Err + undefined, called at bkprun05.bkp:136:30 in app+app-18HBpsO5TPxCVSTvBQxSrq:App diff --git a/testsuite/tests/backpack/should_run/bkprun06.bkp b/testsuite/tests/backpack/should_run/bkprun06.bkp index 596fa897bc..121c59236b 100644 --- a/testsuite/tests/backpack/should_run/bkprun06.bkp +++ b/testsuite/tests/backpack/should_run/bkprun06.bkp @@ -53,8 +53,8 @@ unit sigs where union :: Ord k => Map k a -> Map k a -> Map k a unionWith :: Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a unionWithKey :: Ord k => (k -> a -> a -> a) -> Map k a -> Map k a -> Map k a - unions :: Ord k => [Map k a] -> Map k a - unionsWith :: Ord k => (a -> a -> a) -> [Map k a] -> Map k a + unions :: (Foldable f, Ord k) => f (Map k a) -> Map k a + unionsWith :: (Foldable f, Ord k) => (a -> a -> a) -> f (Map k a) -> Map k a difference :: Ord k => Map k a -> Map k b -> Map k a differenceWith :: Ord k => (a -> b -> Maybe a) -> Map k a -> Map k b -> Map k a differenceWithKey :: Ord k => (k -> a -> b -> Maybe a) -> Map k a -> Map k b -> Map k a @@ -127,8 +127,6 @@ unit sigs where maxView :: Map k a -> Maybe (a, Map k a) minViewWithKey :: Map k a -> Maybe ((k, a), Map k a) maxViewWithKey :: Map k a -> Maybe ((k, a), Map k a) - showTree :: (Show k, Show a) => Map k a -> String - showTreeWith :: (k -> a -> String) -> Bool -> Bool -> Map k a -> String valid :: Ord k => Map k a -> Bool signature MapAsSet where diff --git a/testsuite/tests/backpack/should_run/bkprun09.bkp b/testsuite/tests/backpack/should_run/bkprun09.bkp new file mode 100644 index 0000000000..660826823e --- /dev/null +++ b/testsuite/tests/backpack/should_run/bkprun09.bkp @@ -0,0 +1,22 @@ +unit a where + module A where + type T = Int + y :: Int + y = 4 + +unit p where + signature A where + data T + instance Show T + y :: T + module P where + import A + data S = S {-# UNPACK #-} !T + deriving (Show) + x = S y + +unit main where + dependency p[A=a:A] + module Main where + import P + main = print x diff --git a/testsuite/tests/backpack/should_run/bkprun09.stdout b/testsuite/tests/backpack/should_run/bkprun09.stdout new file mode 100644 index 0000000000..05b43dbfb0 --- /dev/null +++ b/testsuite/tests/backpack/should_run/bkprun09.stdout @@ -0,0 +1 @@ +S 4 diff --git a/testsuite/tests/cabal/T12733/Makefile b/testsuite/tests/cabal/T12733/Makefile index 04de2ada62..03f4bfd03f 100644 --- a/testsuite/tests/cabal/T12733/Makefile +++ b/testsuite/tests/cabal/T12733/Makefile @@ -7,7 +7,7 @@ SETUP=../Setup -v0 T12733: clean $(MAKE) -s --no-print-directory clean '$(GHC_PKG)' init tmp.d - '$(TEST_HC)' -v0 --make Setup + '$(TEST_HC)' $(TEST_HC_OPTS) -v0 --make Setup cp p/P.hs.in1 p/P.hs cd p && $(SETUP) clean cd p && $(SETUP) configure $(CABAL_MINIMAL_BUILD) --with-ghc='$(TEST_HC)' --ghc-options='$(TEST_HC_OPTS)' --package-db=../tmp.d diff --git a/testsuite/tests/cabal/all.T b/testsuite/tests/cabal/all.T index 82c1b1584b..5f1b308565 100644 --- a/testsuite/tests/cabal/all.T +++ b/testsuite/tests/cabal/all.T @@ -1,6 +1,9 @@ def normaliseDynlibNames(str): return re.sub('-ghc[0-9.]+\.', '-ghc<VERSION>.', str) +def ignore_warnings(str): + return re.sub(r'Warning:.*\n', '', str) + test('ghcpkg01', [extra_files(['test.pkg', 'test2.pkg', 'test3.pkg'])], run_command, ['$MAKE -s --no-print-directory ghcpkg01']) # Use ignore_stderr to prevent (when HADDOCK_DOCS=NO): @@ -29,7 +32,7 @@ def normalise_haddock_junk( str ): test('ghcpkg05', [extra_files(['test2.pkg', 'test3.pkg']), - normalise_errmsg_fun(normalise_haddock_junk, normaliseDynlibNames)], + normalise_errmsg_fun(normalise_haddock_junk, normaliseDynlibNames, ignore_warnings)], run_command, ['$MAKE -s --no-print-directory ghcpkg05']) test('ghcpkg06', [extra_files(['test.pkg', 'testdup.pkg'])], run_command, ['$MAKE -s --no-print-directory ghcpkg06']) diff --git a/testsuite/tests/cabal/cabal01/Makefile b/testsuite/tests/cabal/cabal01/Makefile index 8aff27e2df..fb73eae7fd 100644 --- a/testsuite/tests/cabal/cabal01/Makefile +++ b/testsuite/tests/cabal/cabal01/Makefile @@ -21,7 +21,7 @@ $(eval $(call canonicalise,PREFIX)) cabal01: $(MAKE) -s --no-print-directory clean - '$(TEST_HC)' --make -o setup Setup.lhs -v0 + '$(TEST_HC)' $(TEST_HC_OPTS) --make -o setup Setup.lhs -v0 '$(GHC_PKG)' init local.db # We don't make use of -rtsopts in this test, and if it's enabled then diff --git a/testsuite/tests/cabal/cabal01/all.T b/testsuite/tests/cabal/cabal01/all.T index 8da74f5eed..9bf2eb13d5 100644 --- a/testsuite/tests/cabal/cabal01/all.T +++ b/testsuite/tests/cabal/cabal01/all.T @@ -24,5 +24,5 @@ def ignoreLdOutput(str): test('cabal01', [extra_files(['A.hs', 'B/', 'MainA.hs', 'Setup.lhs', 'c_src/', 'hello.c', 'test.cabal']), normalise_errmsg_fun(ignoreLdOutput)], - run_command, + run_command, ['$MAKE -s --no-print-directory cabal01 VANILLA=' + vanilla + ' PROF=' + prof + ' DYN=' + dyn + ' ' + cleanup]) diff --git a/testsuite/tests/cabal/cabal03/Makefile b/testsuite/tests/cabal/cabal03/Makefile index 93589e89b0..1e948cf7bf 100644 --- a/testsuite/tests/cabal/cabal03/Makefile +++ b/testsuite/tests/cabal/cabal03/Makefile @@ -18,7 +18,7 @@ SETUP=../Setup -v0 cabal03: clean $(MAKE) -s --no-print-directory clean '$(GHC_PKG)' init tmp.d - '$(TEST_HC)' -v0 --make Setup + '$(TEST_HC)' $(TEST_HC_OPTS) -v0 --make Setup cd p && $(SETUP) clean cd p && $(SETUP) configure $(CABAL_MINIMAL_BUILD) --with-ghc='$(TEST_HC)' --ghc-options='$(TEST_HC_OPTS)' --package-db=../tmp.d --disable-optimisation --ghc-pkg-option=--force --ipid p-noopt cd p && $(SETUP) build diff --git a/testsuite/tests/cabal/cabal04/Makefile b/testsuite/tests/cabal/cabal04/Makefile index 408a725717..e9366fa349 100644 --- a/testsuite/tests/cabal/cabal04/Makefile +++ b/testsuite/tests/cabal/cabal04/Makefile @@ -12,7 +12,7 @@ SETUP=./Setup -v0 cabal04: $(MAKE) -s --no-print-directory clean - '$(TEST_HC)' -v0 --make Setup + '$(TEST_HC)' $(TEST_HC_OPTS) -v0 --make Setup $(SETUP) clean $(SETUP) configure --with-ghc='$(TEST_HC)' --ghc-options='$(filter-out -rtsopts,$(TEST_HC_OPTS))' $(VANILLA) $(PROF) $(DYN) $(SETUP) build 2> err diff --git a/testsuite/tests/cabal/cabal05/Makefile b/testsuite/tests/cabal/cabal05/Makefile index 981ee6f91c..2651e35a67 100644 --- a/testsuite/tests/cabal/cabal05/Makefile +++ b/testsuite/tests/cabal/cabal05/Makefile @@ -29,7 +29,7 @@ SETUP = ../Setup -v0 cabal05: clean $(MAKE) -s --no-print-directory clean '$(GHC_PKG)' init tmp.d - '$(TEST_HC)' -v0 --make Setup + '$(TEST_HC)' $(TEST_HC_OPTS) -v0 --make Setup # build p cd p && $(SETUP) clean cd p && $(SETUP) configure $(CABAL_MINIMAL_BUILD) --with-ghc='$(TEST_HC)' --ghc-options='$(TEST_HC_OPTS)' --package-db=../tmp.d --prefix='$(PWD)/$$pkgid' diff --git a/testsuite/tests/cabal/cabal06/Makefile b/testsuite/tests/cabal/cabal06/Makefile index c42c5fb24f..842378f64e 100644 --- a/testsuite/tests/cabal/cabal06/Makefile +++ b/testsuite/tests/cabal/cabal06/Makefile @@ -24,7 +24,7 @@ SETUP=../Setup -v0 cabal06: clean $(MAKE) -s --no-print-directory clean '$(GHC_PKG)' init tmp.d - '$(TEST_HC)' -v0 --make Setup + '$(TEST_HC)' $(TEST_HC_OPTS) -v0 --make Setup cd p-1.0 && $(SETUP) clean cd p-1.0 && $(SETUP) configure $(CABAL_MINIMAL_BUILD) --with-ghc='$(TEST_HC)' --ghc-options='$(TEST_HC_OPTS)' --package-db=../tmp.d --prefix='$(PWD)/inst-a' --ghc-pkg-options='--enable-multi-instance' cd p-1.0 && $(SETUP) build diff --git a/testsuite/tests/cabal/cabal08/Makefile b/testsuite/tests/cabal/cabal08/Makefile index fb217ef199..8b9a292ce8 100644 --- a/testsuite/tests/cabal/cabal08/Makefile +++ b/testsuite/tests/cabal/cabal08/Makefile @@ -9,7 +9,7 @@ cabal08: clean $(MAKE) -s --no-print-directory clean '$(GHC_PKG)' init tmp1.d '$(GHC_PKG)' init tmp2.d - '$(TEST_HC)' -v0 --make Setup + '$(TEST_HC)' $(TEST_HC_OPTS) -v0 --make Setup cd p1 && $(SETUP) clean cd p1 && $(SETUP) configure $(CABAL_MINIMAL_BUILD) --with-ghc='$(TEST_HC)' --ghc-options='$(TEST_HC_OPTS)' --package-db=../tmp1.d --prefix='$(PWD)/inst-p1' --ipid="p-0.1-aaa" cd p1 && $(SETUP) build diff --git a/testsuite/tests/cabal/cabal09/Makefile b/testsuite/tests/cabal/cabal09/Makefile index e89c2eaf55..68331c1472 100644 --- a/testsuite/tests/cabal/cabal09/Makefile +++ b/testsuite/tests/cabal/cabal09/Makefile @@ -9,7 +9,7 @@ SETUP = ./Setup -v0 cabal09: clean $(MAKE) clean - '$(TEST_HC)' -v0 --make Setup + '$(TEST_HC)' $(TEST_HC_OPTS) -v0 --make Setup $(SETUP) clean $(SETUP) configure $(CABAL_MINIMAL_BUILD) --with-ghc='$(TEST_HC)' --ghc-options='$(TEST_HC_OPTS)' $(SETUP) build diff --git a/testsuite/tests/cabal/ghcpkg01.stdout b/testsuite/tests/cabal/ghcpkg01.stdout index 7077b3507b..4523e2807b 100644 --- a/testsuite/tests/cabal/ghcpkg01.stdout +++ b/testsuite/tests/cabal/ghcpkg01.stdout @@ -8,20 +8,17 @@ key: testpkg-1.2.3.4-XXX license: BSD3 copyright: (c) The Univsersity of Glasgow 2004 maintainer: glasgow-haskell-users@haskell.org +author: simonmar@microsoft.com stability: stable homepage: http://www.haskell.org/ghc package-url: http://www.haskell.org/ghc description: A Test Package category: none -author: simonmar@microsoft.com exposed: True -indefinite: False exposed-modules: A hidden-modules: B C.D -abi: -trusted: False import-dirs: /usr/local/lib/testpkg "c:/Program Files/testpkg" library-dirs: /usr/local/lib/testpkg "c:/Program Files/testpkg" hs-libraries: testpkg-1.2.3.4-XXX @@ -35,20 +32,17 @@ key: testpkg-1.2.3.4-XXX license: BSD3 copyright: (c) The Univsersity of Glasgow 2004 maintainer: glasgow-haskell-users@haskell.org +author: simonmar@microsoft.com stability: stable homepage: http://www.haskell.org/ghc package-url: http://www.haskell.org/ghc description: A Test Package category: none -author: simonmar@microsoft.com exposed: True -indefinite: False exposed-modules: A hidden-modules: B C.D -abi: -trusted: False import-dirs: /usr/local/lib/testpkg "c:/Program Files/testpkg" library-dirs: /usr/local/lib/testpkg "c:/Program Files/testpkg" hs-libraries: testpkg-1.2.3.4-XXX @@ -68,20 +62,16 @@ key: testpkg-2.0-XXX license: BSD3 copyright: (c) The Univsersity of Glasgow 2004 maintainer: glasgow-haskell-users@haskell.org +author: simonmar@microsoft.com stability: unstable homepage: http://www.haskell.org/ghc package-url: http://www.haskell.org/ghc description: A Test Package (new version) category: none -author: simonmar@microsoft.com -exposed: False -indefinite: False exposed-modules: A hidden-modules: B C.D C.E -abi: -trusted: False import-dirs: /usr/local/lib/testpkg "c:/Program Files/testpkg" library-dirs: /usr/local/lib/testpkg "c:/Program Files/testpkg" hs-libraries: testpkg-2.0-XXX @@ -95,20 +85,16 @@ key: testpkg-2.0-XXX license: BSD3 copyright: (c) The Univsersity of Glasgow 2004 maintainer: glasgow-haskell-users@haskell.org +author: simonmar@microsoft.com stability: unstable homepage: http://www.haskell.org/ghc package-url: http://www.haskell.org/ghc description: A Test Package (new version) category: none -author: simonmar@microsoft.com -exposed: False -indefinite: False exposed-modules: A hidden-modules: B C.D C.E -abi: -trusted: False import-dirs: /usr/local/lib/testpkg "c:/Program Files/testpkg" library-dirs: /usr/local/lib/testpkg "c:/Program Files/testpkg" hs-libraries: testpkg-2.0-XXX @@ -122,20 +108,17 @@ key: testpkg-1.2.3.4-XXX license: BSD3 copyright: (c) The Univsersity of Glasgow 2004 maintainer: glasgow-haskell-users@haskell.org +author: simonmar@microsoft.com stability: stable homepage: http://www.haskell.org/ghc package-url: http://www.haskell.org/ghc description: A Test Package category: none -author: simonmar@microsoft.com exposed: True -indefinite: False exposed-modules: A hidden-modules: B C.D -abi: -trusted: False import-dirs: /usr/local/lib/testpkg "c:/Program Files/testpkg" library-dirs: /usr/local/lib/testpkg "c:/Program Files/testpkg" hs-libraries: testpkg-1.2.3.4-XXX @@ -156,20 +139,16 @@ key: testpkg-1.2.3.4-XXX license: BSD3 copyright: (c) The Univsersity of Glasgow 2004 maintainer: glasgow-haskell-users@haskell.org +author: simonmar@microsoft.com stability: stable homepage: http://www.haskell.org/ghc package-url: http://www.haskell.org/ghc description: A Test Package category: none -author: simonmar@microsoft.com -exposed: False -indefinite: False exposed-modules: A hidden-modules: B C.D -abi: -trusted: False import-dirs: /usr/local/lib/testpkg "c:/Program Files/testpkg" library-dirs: /usr/local/lib/testpkg "c:/Program Files/testpkg" hs-libraries: testpkg-1.2.3.4-XXX diff --git a/testsuite/tests/callarity/unittest/CallArity1.hs b/testsuite/tests/callarity/unittest/CallArity1.hs index 8fd8feb548..1100ff6a8f 100644 --- a/testsuite/tests/callarity/unittest/CallArity1.hs +++ b/testsuite/tests/callarity/unittest/CallArity1.hs @@ -172,7 +172,7 @@ main = do case lintExpr dflags [f,scrutf,scruta] e of Just msg -> putMsg dflags (msg $$ text "in" <+> text n) Nothing -> return () - putMsg dflags (text n <> char ':') + putMsg dflags (text n Outputable.<> char ':') -- liftIO $ putMsg dflags (ppr e) let e' = callArityRHS e let bndrs = nonDetEltsUniqSet (allBoundIds e') diff --git a/testsuite/tests/dph/Makefile b/testsuite/tests/cmm/Makefile index 9a36a1c5fe..9a36a1c5fe 100644 --- a/testsuite/tests/dph/Makefile +++ b/testsuite/tests/cmm/Makefile diff --git a/testsuite/tests/cmm/opt/Makefile b/testsuite/tests/cmm/opt/Makefile new file mode 100644 index 0000000000..3c462ec0c0 --- /dev/null +++ b/testsuite/tests/cmm/opt/Makefile @@ -0,0 +1,6 @@ +TOP=../../.. +include $(TOP)/mk/boilerplate.mk +include $(TOP)/mk/test.mk + +T15188: + '$(TEST_HC)' $(TEST_HC_OPTS) -c -O -ddump-cmm-cps -dsuppress-all T15188.cmm | grep if ; echo $$? diff --git a/testsuite/tests/cmm/opt/T15188.cmm b/testsuite/tests/cmm/opt/T15188.cmm new file mode 100644 index 0000000000..59df92d78e --- /dev/null +++ b/testsuite/tests/cmm/opt/T15188.cmm @@ -0,0 +1,6 @@ +func(bits64 r2) { + foo: + if (r2 == 0) { goto bar; } else { goto bar; } + bar: + return (1); +} diff --git a/testsuite/tests/cmm/opt/T15188.stdout b/testsuite/tests/cmm/opt/T15188.stdout new file mode 100644 index 0000000000..d00491fd7e --- /dev/null +++ b/testsuite/tests/cmm/opt/T15188.stdout @@ -0,0 +1 @@ +1 diff --git a/testsuite/tests/cmm/opt/all.T b/testsuite/tests/cmm/opt/all.T new file mode 100644 index 0000000000..b2c0f5f8e7 --- /dev/null +++ b/testsuite/tests/cmm/opt/all.T @@ -0,0 +1,3 @@ +# Verify that we optimize away conditional branches which always jump +# to the same target. +test('T15188', normal, run_command, ['$MAKE -s --no-print-directory T15188']) diff --git a/testsuite/tests/cmm/should_run/HooplPostorder.hs b/testsuite/tests/cmm/should_run/HooplPostorder.hs new file mode 100644 index 0000000000..d7a8bbaef1 --- /dev/null +++ b/testsuite/tests/cmm/should_run/HooplPostorder.hs @@ -0,0 +1,69 @@ +module Main where + +import Hoopl.Block +import Hoopl.Collections +import Hoopl.Graph +import Hoopl.Label + +import Data.Maybe + +data TestBlock e x = TB { label_ :: Label, successors_ :: [Label] } + deriving (Eq, Show) + +instance NonLocal TestBlock where + entryLabel = label_ + successors = successors_ + +-- Test the classical diamond shape graph. +test_diamond :: LabelMap (TestBlock C C) +test_diamond = mapFromList $ map (\b -> (label_ b, b)) blocks + where + blocks = + [ TB (mkHooplLabel 1) [mkHooplLabel 2, mkHooplLabel 3] + , TB (mkHooplLabel 2) [mkHooplLabel 4] + , TB (mkHooplLabel 3) [mkHooplLabel 4] + , TB (mkHooplLabel 4) [] + ] + +-- Test that the backedge doesn't change anything. +test_diamond_backedge :: LabelMap (TestBlock C C) +test_diamond_backedge = mapFromList $ map (\b -> (label_ b, b)) blocks + where + blocks = + [ TB (mkHooplLabel 1) [mkHooplLabel 2, mkHooplLabel 3] + , TB (mkHooplLabel 2) [mkHooplLabel 4] + , TB (mkHooplLabel 3) [mkHooplLabel 4] + , TB (mkHooplLabel 4) [mkHooplLabel 1] + ] + +-- Test that the "bypass" edge from 1 to 4 doesn't change anything. +test_3 :: LabelMap (TestBlock C C) +test_3 = mapFromList $ map (\b -> (label_ b, b)) blocks + where + blocks = + [ TB (mkHooplLabel 1) [mkHooplLabel 2, mkHooplLabel 4] + , TB (mkHooplLabel 2) [mkHooplLabel 4] + , TB (mkHooplLabel 4) [] + ] + +-- Like test_3 but with different order of successors for the entry point. +test_4 :: LabelMap (TestBlock C C) +test_4 = mapFromList $ map (\b -> (label_ b, b)) blocks + where + blocks = + [ TB (mkHooplLabel 1) [mkHooplLabel 4, mkHooplLabel 2] + , TB (mkHooplLabel 2) [mkHooplLabel 4] + , TB (mkHooplLabel 4) [] + ] + + +main :: IO () +main = do + let result = revPostorderFrom test_diamond (mkHooplLabel 1) + putStrLn (show $ map label_ result) + let result = revPostorderFrom test_diamond_backedge (mkHooplLabel 1) + putStrLn (show $ map label_ result) + let result = revPostorderFrom test_3 (mkHooplLabel 1) + putStrLn (show $ map label_ result) + let result = revPostorderFrom test_4 (mkHooplLabel 1) + putStrLn (show $ map label_ result) diff --git a/testsuite/tests/cmm/should_run/HooplPostorder.stdout b/testsuite/tests/cmm/should_run/HooplPostorder.stdout new file mode 100644 index 0000000000..7e704c224b --- /dev/null +++ b/testsuite/tests/cmm/should_run/HooplPostorder.stdout @@ -0,0 +1,4 @@ +[L1,L3,L2,L4] +[L1,L3,L2,L4] +[L1,L2,L4] +[L1,L2,L4] diff --git a/testsuite/tests/dph/classes/Makefile b/testsuite/tests/cmm/should_run/Makefile index 9101fbd40a..9101fbd40a 100644 --- a/testsuite/tests/dph/classes/Makefile +++ b/testsuite/tests/cmm/should_run/Makefile diff --git a/testsuite/tests/cmm/should_run/all.T b/testsuite/tests/cmm/should_run/all.T new file mode 100644 index 0000000000..00838075cf --- /dev/null +++ b/testsuite/tests/cmm/should_run/all.T @@ -0,0 +1,4 @@ +test('HooplPostorder', + extra_run_opts('"' + config.libdir + '"'), + compile_and_run, + ['-package ghc']) diff --git a/testsuite/tests/codeGen/should_compile/Makefile b/testsuite/tests/codeGen/should_compile/Makefile index a3e03d244b..c94c8b6f92 100644 --- a/testsuite/tests/codeGen/should_compile/Makefile +++ b/testsuite/tests/codeGen/should_compile/Makefile @@ -5,6 +5,9 @@ include $(TOP)/mk/test.mk T2578: '$(TEST_HC)' $(TEST_HC_OPTS) --make T2578 -fforce-recomp -v0 +T14626: + '$(TEST_HC)' $(TEST_HC_OPTS) -c -O -ddump-prep -dsuppress-uniques T14626.hs | grep case + debug: # Without optimisations, we should get annotations for basically # all expressions in the example program. @@ -30,3 +33,11 @@ debug: ./debug rm debug + +T14999: + '$(TEST_HC)' $(TEST_HC_OPTS) -O2 -g -c T14999.cmm -o T14999.o + gdb --batch -ex 'file T14999.o' -ex 'disassemble stg_catch_frame_info' --nx | tr -s '[[:blank:]\n]' + readelf --debug-dump=frames-interp T14999.o | tr -s '[[:blank:]\n]' + +T15196: + '$(TEST_HC)' $(TEST_HC_OPTS) -c -O -ddump-asm T15196.hs | grep "jp " ; echo $$? diff --git a/testsuite/tests/codeGen/should_compile/T14626.hs b/testsuite/tests/codeGen/should_compile/T14626.hs new file mode 100644 index 0000000000..a665694bfc --- /dev/null +++ b/testsuite/tests/codeGen/should_compile/T14626.hs @@ -0,0 +1,15 @@ +{-# LANGUAGE MagicHash #-} + +module T14626 where + +import GHC.Prim + +data T = MkT !Bool + +f v = case v of + MkT y -> dataToTag# y + +-- This should /not/ produce an inner case on the y, thus: +-- f v = case v of +-- MkT y -> case y of z -> dataToTag# z +-- But it was! See Trac #14626 comment:4 diff --git a/testsuite/tests/codeGen/should_compile/T14626.stdout b/testsuite/tests/codeGen/should_compile/T14626.stdout new file mode 100644 index 0000000000..389d3e733a --- /dev/null +++ b/testsuite/tests/codeGen/should_compile/T14626.stdout @@ -0,0 +1,2 @@ + case dt of dt [Occ=Once] { __DEFAULT -> T14626.MkT dt } + case v of { T14626.MkT y [Occ=Once] -> diff --git a/testsuite/tests/codeGen/should_compile/T14999.cmm b/testsuite/tests/codeGen/should_compile/T14999.cmm new file mode 100644 index 0000000000..a3e283b0be --- /dev/null +++ b/testsuite/tests/codeGen/should_compile/T14999.cmm @@ -0,0 +1,11 @@ +#define CATCH_FRAME 34 + +#define SIZEOF_StgCatchFrame (SIZEOF_StgHeader+16) + +INFO_TABLE_RET(stg_catch_frame, CATCH_FRAME, + bits64 info_ptr, bits64 exceptions_blocked, gcptr handler) + return (gcptr ret) +{ + return (ret); +} + diff --git a/testsuite/tests/codeGen/should_compile/T14999.stdout b/testsuite/tests/codeGen/should_compile/T14999.stdout new file mode 100644 index 0000000000..546be1b73c --- /dev/null +++ b/testsuite/tests/codeGen/should_compile/T14999.stdout @@ -0,0 +1,13 @@ +Dump of assembler code for function stg_catch_frame_info: + 0x0000000000000010 <+0>: add $0x18,%rbp + 0x0000000000000014 <+4>: jmpq *0x0(%rbp) +End of assembler dump. +Contents of the .debug_frame section: +00000000 0000000000000014 ffffffff CIE "" cf=1 df=-8 ra=16 + LOC CFA rbp rsp ra +0000000000000000 rbp+0 v+0 s c+0 +00000018 000000000000002c 00000000 FDE cie=00000000 pc=000000000000000f..0000000000000017 + LOC CFA rbp rsp ra +000000000000000f rbp+0 v+0 s c+0 +000000000000000f rbp+24 v+0 s c+0 +0000000000000014 rbp+0 v+0 s c+0 diff --git a/testsuite/tests/codeGen/should_compile/T15196.hs b/testsuite/tests/codeGen/should_compile/T15196.hs new file mode 100644 index 0000000000..6df88d8432 --- /dev/null +++ b/testsuite/tests/codeGen/should_compile/T15196.hs @@ -0,0 +1,4 @@ +module M where + +f :: Double -> Double -> Bool +f x y = if x < y then True else False diff --git a/testsuite/tests/codeGen/should_compile/T15196.stdout b/testsuite/tests/codeGen/should_compile/T15196.stdout new file mode 100644 index 0000000000..56a6051ca2 --- /dev/null +++ b/testsuite/tests/codeGen/should_compile/T15196.stdout @@ -0,0 +1 @@ +1
\ No newline at end of file diff --git a/testsuite/tests/codeGen/should_compile/all.T b/testsuite/tests/codeGen/should_compile/all.T index 6ae4e1cb4e..dd6931f235 100644 --- a/testsuite/tests/codeGen/should_compile/all.T +++ b/testsuite/tests/codeGen/should_compile/all.T @@ -30,8 +30,22 @@ test('debug', run_command, ['$MAKE -s --no-print-directory debug']) test('T9964', normal, compile, ['-O']) test('T10518', [cmm_src], compile, ['']) -test('T10667', [ when((arch('powerpc64') or arch('powerpc64le')), +test('T10667', [ when((arch('powerpc64') or arch('powerpc64le')), expect_broken(11261))], compile, ['-g']) test('T12115', normal, compile, ['']) test('T12355', normal, compile, ['']) +test('T14626', + normal, + run_command, ['$MAKE -s --no-print-directory T14626']) +test('T14999', + [when((arch('powerpc64') or arch('powerpc64le')), expect_broken(11261)), + unless(opsys('linux') and arch('x86_64') and have_gdb() and + have_readelf(), skip)], + run_command, ['$MAKE -s --no-print-directory T14999']) + +# Verify that we optimize away redundant jumps for unordered comparisons. +test('T15196', + [ unless(arch('x86_64'),skip), + only_ways('normal'), + ], run_command, ['$MAKE -s --no-print-directory T15196']) diff --git a/testsuite/tests/codeGen/should_fail/T13233.hs b/testsuite/tests/codeGen/should_fail/T13233.hs index fa5a37b046..1facb77914 100644 --- a/testsuite/tests/codeGen/should_fail/T13233.hs +++ b/testsuite/tests/codeGen/should_fail/T13233.hs @@ -1,5 +1,5 @@ {-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeInType #-} +{-# LANGUAGE PolyKinds #-} {-# LANGUAGE UnboxedTuples #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE MagicHash #-} diff --git a/testsuite/tests/codeGen/should_fail/T13233.stderr b/testsuite/tests/codeGen/should_fail/T13233.stderr index c1cbb97d21..c3683138f8 100644 --- a/testsuite/tests/codeGen/should_fail/T13233.stderr +++ b/testsuite/tests/codeGen/should_fail/T13233.stderr @@ -8,7 +8,9 @@ T13233.hs:14:11: error: T13233.hs:22:16: error: Cannot use primitive with levity-polymorphic arguments: - GHC.Prim.(#,#) :: forall (a :: TYPE rep1) (b :: TYPE rep2). + GHC.Prim.(#,#) :: forall (rep1 :: RuntimeRep) (rep2 :: RuntimeRep) (a :: TYPE + rep1) (b :: TYPE + rep2). a -> b -> (# a, b #) Levity-polymorphic arguments: a :: TYPE rep1 diff --git a/testsuite/tests/codeGen/should_run/T13825-unit.hs b/testsuite/tests/codeGen/should_run/T13825-unit.hs new file mode 100644 index 0000000000..1197dc60fe --- /dev/null +++ b/testsuite/tests/codeGen/should_run/T13825-unit.hs @@ -0,0 +1,78 @@ +module Main where + +import DynFlags +import RepType +import SMRep +import StgCmmLayout +import StgCmmClosure +import GHC +import GhcMonad +import System.Environment +import Platform + +main :: IO () +main = do + [libdir] <- getArgs + runGhc (Just libdir) tests + + +-- How to read tests: +-- F(a,8) = field a at offset 8 +-- P(4,8) = 4 bytes of padding at offset 8 +tests :: Ghc () +tests = do + (_, _, off) <- runTest [("a", FloatRep), ("b", DoubleRep)] + assert_32_64 (map fmt off) + ["F(a,4)", "F(b,8)"] + ["F(a,8)", "P(4,12)", "F(b,16)"] + + (_, _, off) <- runTest [("a", FloatRep), ("b", FloatRep)] + assert_32_64 (map fmt off) + ["F(a,4)", "F(b,8)"] + ["F(a,8)", "F(b,12)"] + + (_, _, off) <- runTest [("a", FloatRep), ("b", FloatRep), ("c", FloatRep)] + assert_32_64 (map fmt off) + ["F(a,4)", "F(b,8)", "F(c,12)"] + ["F(a,8)", "F(b,12)", "F(c,16)", "P(4,20)"] + + (_, _, off) <- runTest [("a", FloatRep), ("b", FloatRep), ("c", Int64Rep)] + assert_32_64 (map fmt off) + ["F(a,4)", "F(b,8)", "F(c,12)"] + ["F(a,8)", "F(b,12)", "F(c,16)"] + + (_, _, off) <- runTest [("a", Int64Rep), ("b", FloatRep), ("c", FloatRep)] + assert_32_64 (map fmt off) + ["F(a,4)", "F(b,12)", "F(c,16)"] + ["F(a,8)", "F(b,16)", "F(c,20)"] + + (_, _, off) <- runTest [("a", Int64Rep), ("b", FloatRep), ("c", Int64Rep)] + assert_32_64 (map fmt off) + ["F(a,4)", "F(b,12)", "F(c,16)"] + ["F(a,8)", "F(b,16)", "P(4,20)", "F(c,24)"] + + +assert_32_64 :: (Eq a, Show a) => a -> a -> a -> Ghc () +assert_32_64 actual expected32 expected64 = do + dflags <- getDynFlags + let + expected + | word_size == 4 = expected32 + | word_size == 8 = expected64 + word_size = wORD_SIZE dflags + case actual == expected of + True -> return () + False -> + error $ "Expected:\n" ++ show expected + ++ "\nBut got:\n" ++ show actual + +runTest :: [(a, PrimRep)] -> Ghc (WordOff , WordOff, [FieldOffOrPadding a]) +runTest prim_reps = do + dflags <- getDynFlags + return $ mkVirtHeapOffsetsWithPadding dflags StdHeader (mkNonVoids prim_reps) + where + mkNonVoids = map (\(a, prim_rep) -> NonVoid (prim_rep, a)) + +fmt :: FieldOffOrPadding String -> String +fmt (FieldOff (NonVoid id) off) = "F(" ++ id ++ "," ++ show off ++ ")" +fmt (Padding len off) = "P(" ++ show len ++ "," ++ show off ++ ")" diff --git a/testsuite/tests/codeGen/should_run/T14251.hs b/testsuite/tests/codeGen/should_run/T14251.hs new file mode 100644 index 0000000000..d31498efe4 --- /dev/null +++ b/testsuite/tests/codeGen/should_run/T14251.hs @@ -0,0 +1,27 @@ +{-# LANGUAGE MagicHash, BangPatterns #-} +module Main where + +import GHC.Exts + +{-# NOINLINE f #-} +f :: (Int# -> Float# -> Double# -> Float# -> Double# -> String) -> String +f g = g 3# 4.0# 5.0## 6.0# 6.9## ++ " World!" + +{-# NOINLINE p #-} +p :: Int# -> Float# -> Double# -> Float# -> Double# -> String +p i j k l m = "Hello" + +{-# NOINLINE q #-} +q :: Int# -> Int# -> Float# -> Double# -> Float# -> Double# -> String +q _ i j k l m = "Hello " ++ show (F# l) ++ " " ++ show (D# m) + +{-# NOINLINE r #-} +r :: Int# -> Float# -> Double# -> Float# -> Double# -> String +r i = let !(I# z) = length [I# 1# .. I# i] in \j k l m -> p z j k l m + -- ghc won't eta-expand around the length, because it has unknown cost + +main = do + putStrLn (f p) -- fast call + putStrLn (f r) -- slow call: function but wrong arity + let g = last [q 1#] + putStrLn (f g) -- slow call: thunk diff --git a/testsuite/tests/codeGen/should_run/T14251.stdout b/testsuite/tests/codeGen/should_run/T14251.stdout new file mode 100644 index 0000000000..de803214d4 --- /dev/null +++ b/testsuite/tests/codeGen/should_run/T14251.stdout @@ -0,0 +1,4 @@ +Hello World! +Hello World! +Hello 6.0 6.9 World! + diff --git a/testsuite/tests/codeGen/should_run/T14346.hs b/testsuite/tests/codeGen/should_run/T14346.hs new file mode 100644 index 0000000000..b61b92bd07 --- /dev/null +++ b/testsuite/tests/codeGen/should_run/T14346.hs @@ -0,0 +1,21 @@ +module Main where + +import Control.Concurrent +import Control.Monad +import Data.Word +import Foreign.Marshal.Alloc +import Foreign.Storable +import Numeric +import GHC.Ptr + +main :: IO () +main = do + replicateM_ 49 $ threadDelay 1 + _ <- forkIO $ do + allocaBytes 4 $ \p -> do + forever $ do + poke p (0xDEADBEEF :: Word32) + threadDelay 10 + x <- peek p + unless (x == 0xDEADBEEF) $ putStrLn (showHex x "") + threadDelay 1000000 diff --git a/testsuite/tests/codeGen/should_run/T14619.hs b/testsuite/tests/codeGen/should_run/T14619.hs new file mode 100644 index 0000000000..7af16dff67 --- /dev/null +++ b/testsuite/tests/codeGen/should_run/T14619.hs @@ -0,0 +1,46 @@ +{-# OPTIONS_GHC -O1 #-} + +{- + On windows some xmm registers are callee saved. This means + they can't be used as scratch registers before a call to C. + + In #14619 this wasn't respected which lead to a wrong value + ending up in xmm6 and being returned in the final result. + + This code compiles to a non trivial fp computation followed + by a call to sqrt at O1+. If xmm6 isn't properly handled it + will be used as a scratch register failing the test. + + The original code used regular sqrt which on 8.2 generated + a C call in the backend. To imitate this behaviour on 8.4+ + we force a call to a C function instead. +-} + +module Main (main) where + + + +import Prelude hiding((*>), (<*)) +import Foreign.C +import Unsafe.Coerce + +foreign import ccall unsafe "sqrt" call_sqrt :: CDouble -> CDouble + +type V3 = (Double, Double, Double) + +absf :: V3 -> V3 -> Double +absf (x, y, z) (x', y', z') = x*x' +y*y'+z*z' + + +{-# NOINLINE sphereIntersection #-} +sphereIntersection :: V3 -> V3 -> (V3) +sphereIntersection orig dir@(_, _, dirz) + | b < 0 = undefined + | t1 > 0 = dir + | t1 < 0 = orig + | otherwise = undefined + where b = orig `absf` dir + sqrtDisc = realToFrac . call_sqrt $ CDouble b + t1 = b - sqrtDisc + +main = print $ sphereIntersection (11, 22, 33) (44, 55, 66) diff --git a/testsuite/tests/codeGen/should_run/T14619.stdout b/testsuite/tests/codeGen/should_run/T14619.stdout new file mode 100644 index 0000000000..a11c04de2e --- /dev/null +++ b/testsuite/tests/codeGen/should_run/T14619.stdout @@ -0,0 +1 @@ +(44.0,55.0,66.0) diff --git a/testsuite/tests/codeGen/should_run/T14754.hs b/testsuite/tests/codeGen/should_run/T14754.hs new file mode 100644 index 0000000000..181659d4eb --- /dev/null +++ b/testsuite/tests/codeGen/should_run/T14754.hs @@ -0,0 +1,15 @@ +module Main where + +import Debug.Trace + +main :: IO () +main = print (alg 3 1) + +alg :: Word -> Word -> Word +alg a b + | traceShow (a, b) False = undefined + | c < b = alg b c + | c > b = alg c b + | otherwise = c + where + c = a - b diff --git a/testsuite/tests/codeGen/should_run/T14754.stderr b/testsuite/tests/codeGen/should_run/T14754.stderr new file mode 100644 index 0000000000..42c78ed097 --- /dev/null +++ b/testsuite/tests/codeGen/should_run/T14754.stderr @@ -0,0 +1,2 @@ +(3,1) +(2,1) diff --git a/testsuite/tests/codeGen/should_run/T14754.stdout b/testsuite/tests/codeGen/should_run/T14754.stdout new file mode 100644 index 0000000000..d00491fd7e --- /dev/null +++ b/testsuite/tests/codeGen/should_run/T14754.stdout @@ -0,0 +1 @@ +1 diff --git a/testsuite/tests/codeGen/should_run/T15038/Makefile b/testsuite/tests/codeGen/should_run/T15038/Makefile new file mode 100644 index 0000000000..48493c08ef --- /dev/null +++ b/testsuite/tests/codeGen/should_run/T15038/Makefile @@ -0,0 +1,15 @@ +TOP=../../../.. +include $(TOP)/mk/boilerplate.mk +include $(TOP)/mk/test.mk + +.PHONY: T15038 +T15038: + '$(TEST_HC)' $(TEST_HC_OPTS) -O2 -o Main \ + ./test/Main.hs \ + ./test/Parser.hs \ + ./src/Packed/Bytes/Stream/ST.hs \ + ./src/Packed/Bytes/Parser.hs \ + ./src/Packed/Bytes.hs \ + ./common/Data/Trie/Naive.hs \ + -package containers -package ghc-prim -package primitive + ./Main diff --git a/testsuite/tests/codeGen/should_run/T15038/all.T b/testsuite/tests/codeGen/should_run/T15038/all.T new file mode 100644 index 0000000000..6b284784ae --- /dev/null +++ b/testsuite/tests/codeGen/should_run/T15038/all.T @@ -0,0 +1,4 @@ +test('T15038', + [reqlib('containers'), reqlib('ghc-prim'), reqlib('primitive')], + run_command, + ['$MAKE -s --no-print-directory T15038']) diff --git a/testsuite/tests/codeGen/should_run/T15038/common/Data/Trie/Naive.hs b/testsuite/tests/codeGen/should_run/T15038/common/Data/Trie/Naive.hs new file mode 100644 index 0000000000..a138615b2d --- /dev/null +++ b/testsuite/tests/codeGen/should_run/T15038/common/Data/Trie/Naive.hs @@ -0,0 +1,80 @@ +{-# LANGUAGE DeriveFunctor #-} + +module Data.Trie.Naive + ( Trie + , singleton + , singletonString + , lookup + , parser + , fromList + , fromListAppend + , fromStringList + ) where + +import Prelude hiding (lookup) + +import Data.Semigroup (Semigroup) +import Data.Word (Word8) +import Data.Map (Map) +import Data.Bifunctor (second) +import Packed.Bytes (Bytes) +import qualified Data.Char +import qualified GHC.OldList as L +import qualified Packed.Bytes.Parser as P +import qualified Packed.Bytes as B +import qualified Data.Semigroup as SG +import qualified Data.Map.Strict as M + +data Trie a = Trie (Maybe a) (Map Word8 (Trie a)) + deriving (Functor) + +instance Semigroup a => Semigroup (Trie a) where + (<>) = append + +instance Semigroup a => Monoid (Trie a) where + mempty = Trie Nothing M.empty + mappend = (SG.<>) + +append :: Semigroup a => Trie a -> Trie a -> Trie a +append (Trie v1 m1) (Trie v2 m2) = Trie + (SG.getOption (SG.Option v1 SG.<> SG.Option v2)) + (M.unionWith append m1 m2) + +singleton :: Bytes -> a -> Trie a +singleton k v = B.foldr (\b r -> Trie Nothing (M.singleton b r)) (Trie (Just v) M.empty) k + +singletonString :: String -> a -> Trie a +singletonString k v = L.foldr (\c r -> Trie Nothing (M.singleton (c2w c) r)) (Trie (Just v) M.empty) k + +lookup :: Bytes -> Trie a -> Maybe a +lookup k t0 = case B.foldr lookupStep (Just t0) k of + Nothing -> Nothing + Just (Trie v _) -> v + +lookupStep :: Word8 -> Maybe (Trie a) -> Maybe (Trie a) +lookupStep w Nothing = Nothing +lookupStep w (Just (Trie _ m)) = M.lookup w m + +parser :: Trie (P.Parser a) -> P.Parser a +parser (Trie mp m) = case mp of + Just p -> p + Nothing -> do + w <- P.any + case M.lookup w m of + Nothing -> P.failure + Just t -> parser t + +fromList :: [(Bytes,a)] -> Trie a +fromList = fmap SG.getFirst . fromListAppend . map (second SG.First) + +fromListAppend :: Semigroup a => [(Bytes,a)] -> Trie a +fromListAppend = foldMap (uncurry singleton) + +fromStringList :: [(String,a)] -> Trie a +fromStringList = fmap SG.getFirst . fromStringListAppend . map (second SG.First) + +fromStringListAppend :: Semigroup a => [(String,a)] -> Trie a +fromStringListAppend = foldMap (uncurry singletonString) + +c2w :: Char -> Word8 +c2w = fromIntegral . Data.Char.ord diff --git a/testsuite/tests/codeGen/should_run/T15038/src/Packed/Bytes.hs b/testsuite/tests/codeGen/should_run/T15038/src/Packed/Bytes.hs new file mode 100644 index 0000000000..224e03f75d --- /dev/null +++ b/testsuite/tests/codeGen/should_run/T15038/src/Packed/Bytes.hs @@ -0,0 +1,80 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE UnboxedTuples #-} +{-# LANGUAGE ScopedTypeVariables #-} + +{-# OPTIONS_GHC + -fno-warn-unsafe + -fno-warn-implicit-prelude + -fno-warn-missing-import-lists + -O2 +#-} + +module Packed.Bytes + ( Bytes(..) + , pack + , unpack + , length + -- * Folds + , foldr + -- * Unsliced Byte Arrays + , fromByteArray + ) where + +import Prelude hiding (take,length,replicate,drop,null,concat,foldr) + +import Data.Primitive (ByteArray(..)) +import Data.Word (Word8) +import Control.Monad.ST (runST, ST) +import qualified Data.Primitive as PM +import qualified GHC.OldList as L + +data Bytes = Bytes + {-# UNPACK #-} !ByteArray -- payload + {-# UNPACK #-} !Int -- offset + {-# UNPACK #-} !Int -- length + +instance Show Bytes where + show x = "pack " ++ show (unpack x) + +pack :: [Word8] -> Bytes +pack bs = let arr = packByteArray bs in Bytes arr 0 (lengthByteArray arr) + +unpack :: Bytes -> [Word8] +unpack (Bytes arr off len) = go off + where + go :: Int -> [Word8] + go !ix = if ix < len + off + then PM.indexByteArray arr ix : go (ix + 1) + else [] + +fromByteArray :: ByteArray -> Bytes +fromByteArray ba = Bytes ba 0 (lengthByteArray ba) + +length :: Bytes -> Int +length (Bytes _ _ len) = len + +foldr :: (Word8 -> a -> a) -> a -> Bytes -> a +foldr f a0 (Bytes arr off0 len) = go off0 where + !end = off0 + len + go !ix = if ix < end + then f (PM.indexByteArray arr ix) (go (ix + 1)) + else a0 + +packByteArray :: [Word8] -> ByteArray +packByteArray ws0 = runST $ do + marr <- PM.newByteArray (L.length ws0) + let go [] !_ = return () + go (w : ws) !ix = PM.writeByteArray marr ix w >> go ws (ix + 1) + go ws0 0 + PM.unsafeFreezeByteArray marr + +unpackByteArray :: ByteArray -> [Word8] +unpackByteArray arr = go 0 where + go :: Int -> [Word8] + go !ix = if ix < lengthByteArray arr + then PM.indexByteArray arr ix : go (ix + 1) + else [] + +lengthByteArray :: ByteArray -> Int +lengthByteArray = PM.sizeofByteArray diff --git a/testsuite/tests/codeGen/should_run/T15038/src/Packed/Bytes/Parser.hs b/testsuite/tests/codeGen/should_run/T15038/src/Packed/Bytes/Parser.hs new file mode 100644 index 0000000000..3f9c42ad52 --- /dev/null +++ b/testsuite/tests/codeGen/should_run/T15038/src/Packed/Bytes/Parser.hs @@ -0,0 +1,165 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeInType #-} +{-# LANGUAGE UnboxedSums #-} +{-# LANGUAGE UnboxedTuples #-} + +{-# OPTIONS_GHC + -Weverything + -fno-warn-unsafe + -fno-warn-implicit-prelude + -fno-warn-missing-import-lists + -fno-warn-noncanonical-monoid-instances + -O2 +#-} + +module Packed.Bytes.Parser + ( Parser(..) + , Result(..) + , Leftovers(..) + , parseStreamST + , any + , failure + ) where + +import Control.Applicative +import Data.Primitive (ByteArray(..)) +import GHC.Int (Int(I#)) +import GHC.ST (ST(..),runST) +import GHC.Types (TYPE) +import GHC.Word (Word8(W8#)) +import Packed.Bytes (Bytes(..)) +import Packed.Bytes.Stream.ST (ByteStream(..)) +import Prelude hiding (any,replicate) + +import qualified Data.Primitive as PM +import qualified Control.Monad + +import GHC.Exts (Int#,ByteArray#,Word#,State#,(+#),(-#),(>#),indexWord8Array#) + +type Bytes# = (# ByteArray#, Int#, Int# #) +type Maybe# (a :: TYPE r) = (# (# #) | a #) +type Leftovers# s = (# Bytes# , ByteStream s #) +type Result# s a = (# Maybe# (Leftovers# s), Maybe# a #) + +data Result s a = Result + { resultLeftovers :: !(Maybe (Leftovers s)) + , resultValue :: !(Maybe a) + } + +data Leftovers s = Leftovers + { leftoversChunk :: {-# UNPACK #-} !Bytes + -- ^ The last chunk pulled from the stream + , leftoversStream :: ByteStream s + -- ^ The remaining stream + } + +data PureResult a = PureResult + { pureResultLeftovers :: {-# UNPACK #-} !Bytes + , pureResultValue :: !(Maybe a) + } deriving (Show) + +emptyByteArray :: ByteArray +emptyByteArray = runST (PM.newByteArray 0 >>= PM.unsafeFreezeByteArray) + +parseStreamST :: ByteStream s -> Parser a -> ST s (Result s a) +parseStreamST stream (Parser f) = ST $ \s0 -> + case f (# | (# (# unboxByteArray emptyByteArray, 0#, 0# #), stream #) #) s0 of + (# s1, r #) -> (# s1, boxResult r #) + +boxResult :: Result# s a -> Result s a +boxResult (# leftovers, val #) = case val of + (# (# #) | #) -> Result (boxLeftovers leftovers) Nothing + (# | a #) -> Result (boxLeftovers leftovers) (Just a) + +boxLeftovers :: Maybe# (Leftovers# s) -> Maybe (Leftovers s) +boxLeftovers (# (# #) | #) = Nothing +boxLeftovers (# | (# theBytes, stream #) #) = Just (Leftovers (boxBytes theBytes) stream) + +instance Functor Parser where + fmap = mapParser + +-- Remember to write liftA2 by hand at some point. +instance Applicative Parser where + pure = pureParser + (<*>) = Control.Monad.ap + +instance Monad Parser where + return = pure + (>>=) = bindLifted + +newtype Parser a = Parser + { getParser :: forall s. + Maybe# (Leftovers# s) + -> State# s + -> (# State# s, Result# s a #) + } + +nextNonEmpty :: ByteStream s -> State# s -> (# State# s, Maybe# (Leftovers# s) #) +nextNonEmpty (ByteStream f) s0 = case f s0 of + (# s1, r #) -> case r of + (# (# #) | #) -> (# s1, (# (# #) | #) #) + (# | (# theBytes@(# _,_,len #), stream #) #) -> case len of + 0# -> nextNonEmpty stream s1 + _ -> (# s1, (# | (# theBytes, stream #) #) #) + +withNonEmpty :: forall s b. + Maybe# (Leftovers# s) + -> State# s + -> (State# s -> (# State# s, Result# s b #)) + -> (Word# -> Bytes# -> ByteStream s -> State# s -> (# State# s, Result# s b #)) + -- The first argument is a Word8, not a full machine word. + -- The second argument is the complete,non-empty chunk + -- with the head byte still intact. + -> (# State# s, Result# s b #) +withNonEmpty (# (# #) | #) s0 g _ = g s0 +withNonEmpty (# | (# bytes0@(# arr0,off0,len0 #), stream0 #) #) s0 g f = case len0 ># 0# of + 1# -> f (indexWord8Array# arr0 off0) bytes0 stream0 s0 + _ -> case nextNonEmpty stream0 s0 of + (# s1, r #) -> case r of + (# (# #) | #) -> g s1 + (# | (# bytes1@(# arr1, off1, _ #), stream1 #) #) -> + f (indexWord8Array# arr1 off1) bytes1 stream1 s1 + +-- | Consume the next byte from the input. +any :: Parser Word8 +any = Parser go where + go :: Maybe# (Leftovers# s) -> State# s -> (# State# s, Result# s Word8 #) + go m s0 = withNonEmpty m s0 + (\s -> (# s, (# (# (# #) | #), (# (# #) | #) #) #)) + (\theByte theBytes stream s -> + (# s, (# (# | (# unsafeDrop# 1# theBytes, stream #) #), (# | W8# theByte #) #) #) + ) + +-- TODO: improve this +mapParser :: (a -> b) -> Parser a -> Parser b +mapParser f p = bindLifted p (pureParser . f) + +pureParser :: a -> Parser a +pureParser a = Parser $ \leftovers0 s0 -> + (# s0, (# leftovers0, (# | a #) #) #) + +bindLifted :: Parser a -> (a -> Parser b) -> Parser b +bindLifted (Parser f) g = Parser $ \leftovers0 s0 -> case f leftovers0 s0 of + (# s1, (# leftovers1, val #) #) -> case val of + (# (# #) | #) -> (# s1, (# leftovers1, (# (# #) | #) #) #) + (# | x #) -> case g x of + Parser k -> k leftovers1 s1 + +-- This assumes that the Bytes is longer than the index. It also does +-- not eliminate zero-length references to byte arrays. +unsafeDrop# :: Int# -> Bytes# -> Bytes# +unsafeDrop# i (# arr, off, len #) = (# arr, off +# i, len -# i #) + +unboxByteArray :: ByteArray -> ByteArray# +unboxByteArray (ByteArray arr) = arr + +boxBytes :: Bytes# -> Bytes +boxBytes (# a, b, c #) = Bytes (ByteArray a) (I# b) (I# c) + +failure :: Parser a +failure = Parser (\m s -> (# s, (# m, (# (# #) | #) #) #)) diff --git a/testsuite/tests/codeGen/should_run/T15038/src/Packed/Bytes/Stream/ST.hs b/testsuite/tests/codeGen/should_run/T15038/src/Packed/Bytes/Stream/ST.hs new file mode 100644 index 0000000000..ffba9c2596 --- /dev/null +++ b/testsuite/tests/codeGen/should_run/T15038/src/Packed/Bytes/Stream/ST.hs @@ -0,0 +1,61 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE UnboxedTuples #-} +{-# LANGUAGE UnboxedSums #-} + +{-# OPTIONS_GHC -O2 #-} + +module Packed.Bytes.Stream.ST + ( ByteStream(..) + , empty + , unpack + , fromBytes + ) where + +import Data.Primitive (Array,ByteArray(..)) +import Data.Semigroup (Semigroup) +import Data.Word (Word8) +import GHC.Exts (RealWorld,State#,Int#,ByteArray#) +import GHC.Int (Int(I#)) +import GHC.ST (ST(..)) +import Packed.Bytes (Bytes(..)) +import System.IO (Handle) +import qualified Data.Primitive as PM +import qualified Data.Semigroup as SG +import qualified Packed.Bytes as B + +type Bytes# = (# ByteArray#, Int#, Int# #) + +newtype ByteStream s = ByteStream + (State# s -> (# State# s, (# (# #) | (# Bytes# , ByteStream s #) #) #) ) + +fromBytes :: Bytes -> ByteStream s +fromBytes b = ByteStream + (\s0 -> (# s0, (# | (# unboxBytes b, empty #) #) #)) + +nextChunk :: ByteStream s -> ST s (Maybe (Bytes,ByteStream s)) +nextChunk (ByteStream f) = ST $ \s0 -> case f s0 of + (# s1, r #) -> case r of + (# (# #) | #) -> (# s1, Nothing #) + (# | (# theBytes, theStream #) #) -> (# s1, Just (boxBytes theBytes, theStream) #) + +empty :: ByteStream s +empty = ByteStream (\s -> (# s, (# (# #) | #) #) ) + +boxBytes :: Bytes# -> Bytes +boxBytes (# a, b, c #) = Bytes (ByteArray a) (I# b) (I# c) + +unboxBytes :: Bytes -> Bytes# +unboxBytes (Bytes (ByteArray a) (I# b) (I# c)) = (# a,b,c #) + +unpack :: ByteStream s -> ST s [Word8] +unpack stream = ST (unpackInternal stream) + +unpackInternal :: ByteStream s -> State# s -> (# State# s, [Word8] #) +unpackInternal (ByteStream f) s0 = case f s0 of + (# s1, r #) -> case r of + (# (# #) | #) -> (# s1, [] #) + (# | (# bytes, stream #) #) -> case unpackInternal stream s1 of + (# s2, ws #) -> (# s2, B.unpack (boxBytes bytes) ++ ws #) diff --git a/testsuite/tests/codeGen/should_run/T15038/test/Main.hs b/testsuite/tests/codeGen/should_run/T15038/test/Main.hs new file mode 100644 index 0000000000..56acd042db --- /dev/null +++ b/testsuite/tests/codeGen/should_run/T15038/test/Main.hs @@ -0,0 +1,4 @@ +import qualified Parser as Parser + +main :: IO () +main = print (iterate Parser.byteParserBadOnce 5 !! 100000) diff --git a/testsuite/tests/codeGen/should_run/T15038/test/Parser.hs b/testsuite/tests/codeGen/should_run/T15038/test/Parser.hs new file mode 100644 index 0000000000..70f9f3336b --- /dev/null +++ b/testsuite/tests/codeGen/should_run/T15038/test/Parser.hs @@ -0,0 +1,61 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE BinaryLiterals #-} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeInType #-} +{-# LANGUAGE UnboxedSums #-} +{-# LANGUAGE UnboxedTuples #-} + +{-# OPTIONS_GHC -Wall #-} + +module Parser + ( byteParserBadOnce + ) where + +import Control.Monad.ST (runST) +import Data.Word (Word8) +import Packed.Bytes (Bytes) +import Packed.Bytes.Parser (Parser) +import Packed.Bytes.Stream.ST (ByteStream) +import qualified Data.Char +import qualified Packed.Bytes as B +import qualified Packed.Bytes.Parser as P +import qualified Packed.Bytes.Stream.ST as Stream + +-- from common directory +import qualified Data.Trie.Naive as Naive + +snmptrapdNaive :: Naive.Trie (Parser Word) +snmptrapdNaive = Naive.fromStringList + [ ("STRING: ", P.any >>= \_ -> return 5) + ] + +runExampleParser :: Parser a -> (forall s. ByteStream s) -> (Maybe a, Maybe String) +runExampleParser parser stream = runST $ do + P.Result mleftovers r <- P.parseStreamST stream parser + mextra <- case mleftovers of + Nothing -> return Nothing + Just (P.Leftovers chunk remainingStream) -> do + bs <- Stream.unpack remainingStream + return (Just (map word8ToChar (B.unpack chunk ++ bs))) + return (r,mextra) + +byteParserBadOnce :: Int -> Int +byteParserBadOnce x = do + let sample = ("STRING: _6_ " ++ show x) + stream = Stream.fromBytes (s2b sample) + expected = 6 + (r,mextra) = runExampleParser (Naive.parser snmptrapdNaive) stream + a1 = if Nothing == mextra then 1 else 0 + a2 = if Just expected == r then 1 else 0 + in a1 + (a2 + x) + +s2b :: String -> Bytes +s2b = B.pack . map charToWord8 + +charToWord8 :: Char -> Word8 +charToWord8 = fromIntegral . Data.Char.ord + +word8ToChar :: Word8 -> Char +word8ToChar = Data.Char.chr . fromIntegral diff --git a/testsuite/tests/codeGen/should_run/T5129.hs b/testsuite/tests/codeGen/should_run/T5129.hs index 6bc1912754..2808f54eae 100644 --- a/testsuite/tests/codeGen/should_run/T5129.hs +++ b/testsuite/tests/codeGen/should_run/T5129.hs @@ -10,12 +10,13 @@ throwIfNegative n | n < 0 = error "negative" data HUnitFailure = HUnitFailure String deriving (Show,Typeable) instance Exception HUnitFailure +assertFailure :: String -> a -- Not an IO function! assertFailure msg = E.throw (HUnitFailure msg) -case_negative = - handleJust errorCalls (const $ return ()) $ do - evaluate $ throwIfNegative (-1) - assertFailure "must throw when given a negative number" +main :: IO () +main = + handleJust errorCalls (const (return ())) (do + evaluate (throwIfNegative (-1)) -- Pure expression evaluated in IO + assertFailure "must throw when given a negative number") where errorCalls (ErrorCall _) = Just () -main = case_negative diff --git a/testsuite/tests/codeGen/should_run/all.T b/testsuite/tests/codeGen/should_run/all.T index 6318341abb..49592951bc 100644 --- a/testsuite/tests/codeGen/should_run/all.T +++ b/testsuite/tests/codeGen/should_run/all.T @@ -77,6 +77,8 @@ test('cgrun069', omit_ways(['ghci']), multi_compile_and_run, test('cgrun070', normal, compile_and_run, ['']) test('cgrun071', normal, compile_and_run, ['']) test('cgrun072', normal, compile_and_run, ['']) +test('cgrun075', normal, compile_and_run, ['']) +test('cgrun076', normal, compile_and_run, ['']) test('T1852', normal, compile_and_run, ['']) test('T1861', extra_run_opts('0'), compile_and_run, ['']) @@ -88,11 +90,16 @@ test('T3677', extra_run_opts('+RTS -K8k -RTS'), compile_and_run, ['']) test('T4441', normal, compile_and_run, ['']) test('T5149', omit_ways(['ghci']), multi_compile_and_run, ['T5149', [('T5149_cmm.cmm', '')], '']) -test('T5129', normal, compile_and_run, ['']) +test('T5129', + # The bug is in simplifier when run with -O1 and above, so only run it + # optimised, using any backend. + only_ways(['optasm']), + compile_and_run, ['']) test('T5626', exit_code(1), compile_and_run, ['']) test('T5747', when(arch('i386'), extra_hc_opts('-msse2')), compile_and_run, ['-O2']) test('T5785', normal, compile_and_run, ['']) test('setByteArray', normal, compile_and_run, ['']) +test('compareByteArrays', normal, compile_and_run, ['']) test('T6146', normal, compile_and_run, ['']) test('T5900', normal, compile_and_run, ['']) @@ -148,7 +155,7 @@ test('PopCnt', omit_ways(['ghci']), multi_compile_and_run, ['PopCnt', [('PopCnt_cmm.cmm', '')], '']) test('T12059', normal, compile_and_run, ['']) test('T12433', normal, compile_and_run, ['']) -test('T12622', expect_broken_for(13481, ['ghci']), multimod_compile_and_run, ['T12622', '-O']) +test('T12622', normal, multimod_compile_and_run, ['T12622', '-O']) test('T12757', normal, compile_and_run, ['']) test('T12855', normal, compile_and_run, ['']) test('T9577', [ unless(arch('x86_64') or arch('i386'),skip), @@ -158,3 +165,12 @@ test('T9577', [ unless(arch('x86_64') or arch('i386'),skip), test('T13425', normal, compile_and_run, ['-O']) test('castFloatWord', normal, compile_and_run, ['-dcmm-lint']) +test('T13825-unit', + extra_run_opts('"' + config.libdir + '"'), + compile_and_run, + ['-package ghc']) +test('T14619', normal, compile_and_run, ['']) +test('T14754', normal, compile_and_run, ['']) +test('T14346', only_ways(['threaded1','threaded2']), compile_and_run, ['-O -threaded']) +test('T14251', [expect_broken_for(14251, ['optllvm'])], + compile_and_run, ['']) diff --git a/testsuite/tests/codeGen/should_run/cgrun075.hs b/testsuite/tests/codeGen/should_run/cgrun075.hs new file mode 100644 index 0000000000..09e35b4d8a --- /dev/null +++ b/testsuite/tests/codeGen/should_run/cgrun075.hs @@ -0,0 +1,115 @@ +{-# LANGUAGE BangPatterns, CPP, MagicHash #-} + +module Main ( main ) where + +import Data.Bits +import GHC.Int +import GHC.Prim +import GHC.Word +import Data.Int +import Data.Word + +#include "MachDeps.h" + +main = putStr + ( test_pdep ++ "\n" + ++ test_pdep8 ++ "\n" + ++ test_pdep16 ++ "\n" + ++ test_pdep32 ++ "\n" + ++ test_pdep64 ++ "\n" + ++ "\n" + ) + +class Pdep a where + pdep :: a -> a -> a + +instance Pdep Word where + pdep (W# src#) (W# mask#) = W# (pdep# src# mask#) + +instance Pdep Word8 where + pdep (W8# src#) (W8# mask#) = W8# (pdep8# src# mask#) + +instance Pdep Word16 where + pdep (W16# src#) (W16# mask#) = W16# (pdep16# src# mask#) + +instance Pdep Word32 where + pdep (W32# src#) (W32# mask#) = W32# (pdep32# src# mask#) + +instance Pdep Word64 where + pdep (W64# src#) (W64# mask#) = W64# (pdep64# src# mask#) + +class SlowPdep a where + slowPdep :: a -> a -> a + +instance SlowPdep Word where + slowPdep s m = fromIntegral (slowPdep64 (fromIntegral s) (fromIntegral m)) + +instance SlowPdep Word8 where + slowPdep s m = fromIntegral (slowPdep64 (fromIntegral s) (fromIntegral m)) + +instance SlowPdep Word16 where + slowPdep s m = fromIntegral (slowPdep64 (fromIntegral s) (fromIntegral m)) + +instance SlowPdep Word32 where + slowPdep s m = fromIntegral (slowPdep64 (fromIntegral s) (fromIntegral m)) + +instance SlowPdep Word64 where + slowPdep s m = fromIntegral (slowPdep64 (fromIntegral s) (fromIntegral m)) + +slowPdep64 :: Word64 -> Word64 -> Word64 +slowPdep64 = slowPdep64' 0 + +slowPdep32 :: Word32 -> Word32 -> Word32 +slowPdep32 s m = fromIntegral (slowPdep64 (fromIntegral s) (fromIntegral m)) + +lsb :: Word64 -> Word64 +lsb src = fromIntegral ((fromIntegral (src `shiftL` 63) :: Int64) `shiftR` 63) + +slowPdep64' :: Word64 -> Word64 -> Word64 -> Word64 +slowPdep64' result src mask = if lowest /= 0 + then slowPdep64' newResult (src `shiftR` 1) (mask .&. complement lowest) + else result + where lowest = (-mask) .&. mask + newResult = (result .|. ((lsb src) .&. lowest)) + +test_pdep = test (0 :: Word ) pdep slowPdep +test_pdep8 = test (0 :: Word8 ) pdep slowPdep +test_pdep16 = test (0 :: Word16) pdep slowPdep +test_pdep32 = test (0 :: Word32) pdep slowPdep +test_pdep64 = test (0 :: Word64) pdep slowPdep + +mask n = (2 ^ n) - 1 + +fst4 :: (a, b, c, d) -> a +fst4 (a, _, _, _) = a + +runCase :: Eq a + => (a -> a -> a) + -> (a -> a -> a) + -> (a, a) + -> (Bool, a, a, (a, a)) +runCase fast slow (x, y) = (slow x y == fast x y, slow x y, fast x y, (x, y)) + +test :: (Show a, Num a, Eq a) => a -> (a -> a -> a) -> (a -> a -> a) -> String +test _ fast slow = case failing of + [] -> "OK" + ((_, e, a, i):xs) -> + "FAIL\n" ++ " Input: " ++ show i ++ "\nExpected: " ++ show e ++ + "\n Actual: " ++ show a + where failing = dropWhile fst4 . map (runCase fast slow) $ cases + cases = (,) <$> numbers <*> numbers + -- 10 random numbers +#if SIZEOF_HSWORD == 4 + numbers = [ 1480294021, 1626858410, 2316287658, 1246556957, 3806579062 + , 65945563 , 1521588071, 791321966 , 1355466914, 2284998160 + ] +#elif SIZEOF_HSWORD == 8 + numbers = [ 11004539497957619752, 5625461252166958202 + , 1799960778872209546 , 16979826074020750638 + , 12789915432197771481, 11680809699809094550 + , 13208678822802632247, 13794454868797172383 + , 13364728999716654549, 17516539991479925226 + ] +#else +# error Unexpected word size +#endif diff --git a/testsuite/tests/codeGen/should_run/cgrun075.stdout b/testsuite/tests/codeGen/should_run/cgrun075.stdout new file mode 100644 index 0000000000..e22e2cd950 --- /dev/null +++ b/testsuite/tests/codeGen/should_run/cgrun075.stdout @@ -0,0 +1,6 @@ +OK +OK +OK +OK +OK + diff --git a/testsuite/tests/codeGen/should_run/cgrun076.hs b/testsuite/tests/codeGen/should_run/cgrun076.hs new file mode 100644 index 0000000000..7fa42d74e0 --- /dev/null +++ b/testsuite/tests/codeGen/should_run/cgrun076.hs @@ -0,0 +1,115 @@ +{-# LANGUAGE BangPatterns, CPP, MagicHash #-} + +module Main ( main ) where + +import Data.Bits +import GHC.Int +import GHC.Prim +import GHC.Word +import Data.Int +import Data.Word + +#include "MachDeps.h" + +main = putStr + ( test_pext ++ "\n" + ++ test_pext8 ++ "\n" + ++ test_pext16 ++ "\n" + ++ test_pext32 ++ "\n" + ++ test_pext64 ++ "\n" + ++ "\n" + ) + +class Pext a where + pext :: a -> a -> a + +instance Pext Word where + pext (W# src#) (W# mask#) = W# (pext# src# mask#) + +instance Pext Word8 where + pext (W8# src#) (W8# mask#) = W8# (pext8# src# mask#) + +instance Pext Word16 where + pext (W16# src#) (W16# mask#) = W16# (pext16# src# mask#) + +instance Pext Word32 where + pext (W32# src#) (W32# mask#) = W32# (pext32# src# mask#) + +instance Pext Word64 where + pext (W64# src#) (W64# mask#) = W64# (pext64# src# mask#) + +class SlowPext a where + slowPext :: a -> a -> a + +instance SlowPext Word where + slowPext s m = fromIntegral (slowPext64 (fromIntegral s) (fromIntegral m)) + +instance SlowPext Word8 where + slowPext s m = fromIntegral (slowPext64 (fromIntegral s) (fromIntegral m)) + +instance SlowPext Word16 where + slowPext s m = fromIntegral (slowPext64 (fromIntegral s) (fromIntegral m)) + +instance SlowPext Word32 where + slowPext s m = fromIntegral (slowPext64 (fromIntegral s) (fromIntegral m)) + +instance SlowPext Word64 where + slowPext s m = fromIntegral (slowPext64 (fromIntegral s) (fromIntegral m)) + +slowPext64 :: Word64 -> Word64 -> Word64 +slowPext64 = slowPext64' 0 0 0 + +slowPext32 :: Word32 -> Word32 -> Word32 +slowPext32 s m = fromIntegral (slowPext64 (fromIntegral s) (fromIntegral m)) + +slowPext64' :: Word64 -> Int -> Int -> Word64 -> Word64 -> Word64 +slowPext64' result offset index src mask = if index /= 64 + then if maskBit /= 0 + then slowPext64' nextResult (offset + 1) (index + 1) src mask + else slowPext64' result offset (index + 1) src mask + else result + where srcBit = (src `shiftR` index) .&. 1 + maskBit = (mask `shiftR` index) .&. 1 + nextResult = result .|. (srcBit `shiftL` offset) + +test_pext = test (0 :: Word ) pext slowPext +test_pext8 = test (0 :: Word8 ) pext slowPext +test_pext16 = test (0 :: Word16) pext slowPext +test_pext32 = test (0 :: Word32) pext slowPext +test_pext64 = test (0 :: Word64) pext slowPext + +mask n = (2 ^ n) - 1 + +fst4 :: (a, b, c, d) -> a +fst4 (a, _, _, _) = a + +runCase :: Eq a + => (a -> a -> a) + -> (a -> a -> a) + -> (a, a) + -> (Bool, a, a, (a, a)) +runCase fast slow (x, y) = (slow x y == fast x y, slow x y, fast x y, (x, y)) + +test :: (Show a, Num a, Eq a) => a -> (a -> a -> a) -> (a -> a -> a) -> String +test _ fast slow = case failing of + [] -> "OK" + ((_, e, a, i):xs) -> + "FAIL\n" ++ " Input: " ++ show i ++ "\nExpected: " ++ show e ++ + "\n Actual: " ++ show a + where failing = dropWhile fst4 . map (runCase fast slow) $ cases + cases = (,) <$> numbers <*> numbers + -- 10 random numbers +#if SIZEOF_HSWORD == 4 + numbers = [ 1480294021, 1626858410, 2316287658, 1246556957, 3806579062 + , 65945563 , 1521588071, 791321966 , 1355466914, 2284998160 + ] +#elif SIZEOF_HSWORD == 8 + numbers = [ 11004539497957619752, 5625461252166958202 + , 1799960778872209546 , 16979826074020750638 + , 12789915432197771481, 11680809699809094550 + , 13208678822802632247, 13794454868797172383 + , 13364728999716654549, 17516539991479925226 + ] +#else +# error Unexpected word size +#endif diff --git a/testsuite/tests/codeGen/should_run/cgrun076.stdout b/testsuite/tests/codeGen/should_run/cgrun076.stdout new file mode 100644 index 0000000000..e22e2cd950 --- /dev/null +++ b/testsuite/tests/codeGen/should_run/cgrun076.stdout @@ -0,0 +1,6 @@ +OK +OK +OK +OK +OK + diff --git a/testsuite/tests/codeGen/should_run/compareByteArrays.hs b/testsuite/tests/codeGen/should_run/compareByteArrays.hs new file mode 100644 index 0000000000..e08328d27d --- /dev/null +++ b/testsuite/tests/codeGen/should_run/compareByteArrays.hs @@ -0,0 +1,167 @@ +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE UnboxedTuples #-} + +-- exercise the 'compareByteArray#' primitive + +module Main (main) where + +import Control.Monad +import Control.Monad.ST +import Data.List +import GHC.Exts (Int (..)) +import GHC.Prim +import GHC.ST (ST (ST)) +import GHC.Word (Word8 (..)) +import Text.Printf + +data BA = BA# ByteArray# + +instance Show BA where + show xs = "[" ++ intercalate "," (map (printf "0x%02x") (unpack xs)) ++ "]" + +instance Eq BA where + x == y = eqByteArray x 0 (sizeofByteArray x) y 0 (sizeofByteArray y) + +instance Ord BA where + compare x y = ordByteArray x 0 (sizeofByteArray x) y 0 (sizeofByteArray y) + +compareByteArrays :: BA -> Int -> BA -> Int -> Int -> Int +compareByteArrays (BA# ba1#) (I# ofs1#) (BA# ba2#) (I# ofs2#) (I# n#) + = I# (compareByteArrays# ba1# ofs1# ba2# ofs2# n#) + +{- +copyByteArray :: BA -> Int -> MBA s -> Int -> Int -> ST s () +copyByteArray (BA# src#) (I# srcOfs#) (MBA# dest#) (I# destOfs#) (I# n#) + = ST $ \s -> case copyByteArray# src# srcOfs# dest# destOfs# n# s of + s' -> (# s', () #) +-} + +indexWord8Array :: BA -> Int -> Word8 +indexWord8Array (BA# ba#) (I# i#) + = W8# (indexWord8Array# ba# i#) + +sizeofByteArray :: BA -> Int +sizeofByteArray (BA# ba#) = I# (sizeofByteArray# ba#) + + +data MBA s = MBA# (MutableByteArray# s) + +newByteArray :: Int -> ST s (MBA s) +newByteArray (I# n#) + = ST $ \s -> case newByteArray# n# s of + (# s', mba# #) -> (# s', MBA# mba# #) + +writeWord8Array :: MBA s -> Int -> Word8 -> ST s () +writeWord8Array (MBA# mba#) (I# i#) (W8# j#) + = ST $ \s -> case writeWord8Array# mba# i# j# s of + s' -> (# s', () #) + +unsafeFreezeByteArray :: MBA s -> ST s BA +unsafeFreezeByteArray (MBA# mba#) + = ST $ \s -> case unsafeFreezeByteArray# mba# s of + (# s', ba# #) -> (# s', BA# ba# #) + +---------------------------------------------------------------------------- +-- high-level operations + +createByteArray :: Int -> (forall s. MBA s -> ST s ()) -> BA +createByteArray n go = runST $ do + mba <- newByteArray n + go mba + unsafeFreezeByteArray mba + +pack :: [Word8] -> BA +pack xs = createByteArray (length xs) $ \mba -> do + let go _ [] = pure () + go i (y:ys) = do + writeWord8Array mba i y + go (i+1) ys + go 0 xs + +unpack :: BA -> [Word8] +unpack ba = go 0 + where + go i | i < sz = indexWord8Array ba i : go (i+1) + | otherwise = [] + sz = sizeofByteArray ba + +eqByteArray :: BA -> Int -> Int -> BA -> Int -> Int -> Bool +eqByteArray ba1 ofs1 n1 ba2 ofs2 n2 + | n1 /= n2 = False + | n1 == 0 = True + | otherwise = compareByteArrays ba1 ofs1 ba2 ofs2 n1 == 0 + +ordByteArray :: BA -> Int -> Int -> BA -> Int -> Int -> Ordering +ordByteArray ba1 ofs1 n1 ba2 ofs2 n2 + | n == 0 = compare n1 n2 + | otherwise = case compareByteArrays ba1 ofs1 ba2 ofs2 n of + r | r < 0 -> LT + | r > 0 -> GT + | n1 < n2 -> LT + | n1 > n2 -> GT + | otherwise -> EQ + where + n = n1 `min` n2 + +main :: IO () +main = do + putStrLn "BEGIN" + -- a couple of low-level tests + print (compareByteArrays s1 0 s2 0 4 `compare` 0) + print (compareByteArrays s2 0 s1 0 4 `compare` 0) + print (compareByteArrays s1 0 s2 0 3 `compare` 0) + print (compareByteArrays s1 0 s2 1 3 `compare` 0) + print (compareByteArrays s1 3 s2 2 1 `compare` 0) + + forM_ [(s1,s1),(s1,s2),(s2,s1),(s2,s2)] $ \(x,y) -> do + print (x == y, compare x y) + + -- realistic test + print (sort (map pack strs) == map pack (sort strs)) + + -- brute-force test + forM_ [1..15] $ \n -> do + forM_ [0..rnglen-(n+1)] $ \j -> do + forM_ [0..rnglen-(n+1)] $ \k -> do + let iut = compareByteArrays srng j srng k n `compare` 0 + ref = (take n (drop j rng) `compare` take n (drop k rng)) + unless (iut == ref) $ + print ("FAIL",n,j,k,iut,ref) + + putStrLn "END" + where + s1, s2 :: BA + s1 = pack [0xca,0xfe,0xba,0xbe] + s2 = pack [0xde,0xad,0xbe,0xef] + + strs = let go i xs = case splitAt (i `mod` 5) xs of + ([],[]) -> [] + (y,ys) -> y : go (i+1) ys + in go 1 rng + + srng = pack rng + + rnglen = length rng + + rng :: [Word8] + rng = [ 0xc1, 0x60, 0x31, 0xb6, 0x46, 0x81, 0xa7, 0xc6, 0xa8, 0xf4, 0x1e, 0x5d, 0xb7, 0x7c, 0x0b, 0xcd + , 0x10, 0xfa, 0xe3, 0xdd, 0xf4, 0x26, 0xf9, 0x50, 0x4b, 0x9c, 0xdf, 0xc4, 0xda, 0xca, 0xc1, 0x60 + , 0x91, 0xf8, 0x70, 0x1a, 0x53, 0x89, 0xf1, 0xd9, 0xee, 0xff, 0x52, 0xb8, 0x1c, 0x5e, 0x25, 0x69 + , 0xd1, 0xa1, 0x08, 0x47, 0x93, 0x89, 0x71, 0x7a, 0xe4, 0x56, 0x24, 0x1b, 0xa1, 0x43, 0x63, 0xc0 + , 0x4d, 0xec, 0x93, 0x30, 0xb7, 0x98, 0x19, 0x23, 0x4e, 0x00, 0x76, 0x7e, 0xf4, 0xcc, 0x8b, 0x92 + , 0x19, 0xc5, 0x3d, 0xf4, 0xa0, 0x4f, 0xe3, 0x64, 0x1b, 0x4e, 0x01, 0xc9, 0xfc, 0x47, 0x3e, 0x16 + , 0xa4, 0x78, 0xdd, 0x12, 0x20, 0xa6, 0x0b, 0xcd, 0x82, 0x06, 0xd0, 0x2a, 0x19, 0x2d, 0x2f, 0xf2 + , 0x8a, 0xf0, 0xc2, 0x2d, 0x0e, 0xfb, 0x39, 0x55, 0xb2, 0xfb, 0x6e, 0xd0, 0xfa, 0xf0, 0x87, 0x57 + , 0x93, 0xa3, 0xae, 0x36, 0x1f, 0xcf, 0x91, 0x45, 0x44, 0x11, 0x62, 0x7f, 0x18, 0x9a, 0xcb, 0x54 + , 0x78, 0x3c, 0x04, 0xbe, 0x3e, 0xd4, 0x2c, 0xbf, 0x73, 0x38, 0x9e, 0xf5, 0xc9, 0xbe, 0xd9, 0xf8 + , 0xe5, 0xf5, 0x41, 0xbb, 0x84, 0x03, 0x2c, 0xe2, 0x0d, 0xe5, 0x8b, 0x1c, 0x75, 0xf7, 0x4c, 0x49 + , 0xfe, 0xac, 0x9f, 0xf4, 0x36, 0xf2, 0xba, 0x5f, 0xc0, 0xda, 0x24, 0xfc, 0x10, 0x61, 0xf0, 0xb6 + , 0xa7, 0xc7, 0xba, 0xc6, 0xb0, 0x41, 0x04, 0x8c, 0xd0, 0xe8, 0x48, 0x41, 0x38, 0xa4, 0x84, 0x21 + , 0xb6, 0xb1, 0x21, 0x33, 0x58, 0xf2, 0xa5, 0xe5, 0x73, 0xf2, 0xd7, 0xbc, 0xc7, 0x7e, 0x86, 0xee + , 0x81, 0xb1, 0xcd, 0x42, 0xc0, 0x2c, 0xd0, 0xa0, 0x8d, 0xb5, 0x4a, 0x5b, 0xc1, 0xfe, 0xcc, 0x92 + , 0x59, 0xf4, 0x71, 0x96, 0x58, 0x6a, 0xb6, 0xa2, 0xf7, 0x67, 0x76, 0x01, 0xc5, 0x8b, 0xc9, 0x6f + , 0x38, 0x93, 0xf3, 0xaa, 0x89, 0xf7, 0xb2, 0x2a, 0x0f, 0x19, 0x7b, 0x48, 0xbe, 0x86, 0x37, 0xd1 + , 0x30, 0xfa, 0xce, 0x72, 0xf4, 0x25, 0x64, 0xee, 0xde, 0x3a, 0x5c, 0x02, 0x32, 0xe6, 0x31, 0x3a + , 0x4b, 0x18, 0x47, 0x30, 0xa4, 0x2c, 0xf8, 0x4d, 0xc5, 0xee, 0x0b, 0x9c, 0x75, 0x43, 0x2a, 0xf9 + ] diff --git a/testsuite/tests/codeGen/should_run/compareByteArrays.stdout b/testsuite/tests/codeGen/should_run/compareByteArrays.stdout new file mode 100644 index 0000000000..eaaa05ef44 --- /dev/null +++ b/testsuite/tests/codeGen/should_run/compareByteArrays.stdout @@ -0,0 +1,12 @@ +BEGIN +LT +GT +LT +GT +EQ +(True,EQ) +(False,LT) +(False,GT) +(True,EQ) +True +END diff --git a/testsuite/tests/concurrent/T13615/all.T b/testsuite/tests/concurrent/T13615/all.T index bac4d0167a..681f7b062c 100644 --- a/testsuite/tests/concurrent/T13615/all.T +++ b/testsuite/tests/concurrent/T13615/all.T @@ -1,5 +1,6 @@ test('T13615', [when(fast(), skip), + req_smp, # needs -N support only_ways(threaded_ways), extra_files(['Parallel.hs', 'Memo.hs']), # Decrease stack chunk size and lots of capabilities to increase failure diff --git a/testsuite/tests/concurrent/prog002/all.T b/testsuite/tests/concurrent/prog002/all.T index 8cf3d87f90..4b330cde98 100644 --- a/testsuite/tests/concurrent/prog002/all.T +++ b/testsuite/tests/concurrent/prog002/all.T @@ -1,7 +1,7 @@ # Test for bug #713, results in crashes in GHC prior to 20060315 with +RTS -N2 # Add 'threaded2_hT' so that we have at least one test for bug #5127 -if (ghc_with_threaded_rts == 1 and ghc_with_smp == 1): +if ghc_with_threaded_rts and ghc_with_smp: ways = ['threaded2_hT'] else: ways = [] diff --git a/testsuite/tests/concurrent/should_run/T13916.hs b/testsuite/tests/concurrent/should_run/T13916.hs new file mode 100755 index 0000000000..e81aabb5a8 --- /dev/null +++ b/testsuite/tests/concurrent/should_run/T13916.hs @@ -0,0 +1,33 @@ +module Main where + +import Data.IORef +import System.IO.Unsafe +import Control.Concurrent.STM +import Control.Concurrent.Async +import Control.Concurrent +import System.IO +import System.Directory +import System.FilePath +import T13916_Bracket + +type Thing = MVar Bool + +main :: IO () +main = do + withEnvCache limit spawner $ \cache -> + forConcurrently_ [1..1000 :: Int] $ \n -> withEnv cache (\handle -> put handle n) + where + limit :: Limit + limit = Hard 1 + + put handle n = return () + +spawner :: Spawner Thing +spawner = Spawner + { maker = mkhandle + , killer = \thing -> takeMVar thing >> putMVar thing True + , isDead = \thing -> readMVar thing + } + +mkhandle :: IO Thing +mkhandle = newMVar False diff --git a/testsuite/tests/concurrent/should_run/T13916_Bracket.hs b/testsuite/tests/concurrent/should_run/T13916_Bracket.hs new file mode 100755 index 0000000000..b09adfc860 --- /dev/null +++ b/testsuite/tests/concurrent/should_run/T13916_Bracket.hs @@ -0,0 +1,135 @@ +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE RecordWildCards #-} +{- | +Module : Bracket +Description : Handling multiple environments with bracket-like apis +Maintainer : robertkennedy@clearwateranalytics.com +Stability : stable + +This module is meant for ie Sql or mongo connections, where you may wish for some number of easy to grab +environments. In particular, this assumes your connection has some initialization/release functions + +This module creates bugs with any optimizations enabled. The bugs do not occur if the program is in the same +module. +-} +module T13916_Bracket ( + -- * Data Types + Spawner(..), Limit(..), Cache, + -- * Usage + withEnvCache, withEnv + ) where + +import Control.Concurrent.STM +import Control.Concurrent.STM.TSem +import Control.Exception hiding (handle) +import Control.Monad +import Data.Vector (Vector) +import qualified Data.Vector as Vector + +-- * Data Types +-- | Tells the program how many environments it is allowed to spawn. +-- A `Lax` limit will spawn extra connections if the `Cache` is empty, +-- while a `Hard` limit will not spawn any more than the given number of connections simultaneously. +-- +-- @since 0.3.7 +data Limit = Hard {getLimit :: {-# unpack #-} !Int} + +data Spawner env = Spawner + { maker :: IO env + , killer :: env -> IO () + , isDead :: env -> IO Bool + } + +type VCache env = Vector (TMVar env) +data Cache env = Unlimited { spawner :: Spawner env + , vcache :: !(VCache env) + } + | Limited { spawner :: Spawner env + , vcache :: !(VCache env) + , envsem :: TSem + } + +-- ** Initialization +withEnvCache :: Limit -> Spawner env -> (Cache env -> IO a) -> IO a +withEnvCache limit spawner = bracket starter releaseCache + where starter = case limit of + Hard n -> Limited spawner <$> initializeEmptyCache n <*> atomically (newTSem n) + +-- ** Using a single value +withEnv :: Cache env -> (env -> IO a) -> IO a +withEnv cache = case cache of + Unlimited{..} -> withEnvUnlimited spawner vcache + Limited{..} -> withEnvLimited spawner vcache envsem + +-- *** Unlimited +-- | Takes an env and returns it on completion of the function. +-- If all envs are already taken or closed, this will spin up a new env. +-- When the function finishes, this will attempt to put the env into the cache. If it cannot, +-- it will kill the env. Note this can lead to many concurrent connections. +-- +-- @since 0.3.5 +withEnvUnlimited :: Spawner env -> VCache env -> (env -> IO a) -> IO a +withEnvUnlimited Spawner{..} cache = bracket taker putter + where + taker = do + mpipe <- atomically $ tryTakeEnv cache + case mpipe of + Nothing -> maker + Just env -> isDead env >>= \b -> if not b then return env else killer env >> maker + + putter env = do + accepted <- atomically $ tryPutEnv cache env + unless accepted $ killer env + +-- *** Limited +-- | Takes an env and returns it on completion of the function. +-- If all envs are already taken, this will wait. This should have a constant number of environments +-- +-- @since 0.3.6 +withEnvLimited :: Spawner env -> VCache env -> TSem -> (env -> IO a) -> IO a +withEnvLimited spawner vcache envsem = bracket taker putter + where + taker = limitMakeEnv spawner vcache envsem + putter env = atomically $ putEnv vcache env + +limitMakeEnv :: Spawner env -> VCache env -> TSem -> IO env +limitMakeEnv Spawner{..} vcache envsem = go + where + go = do + eenvpermission <- atomically $ ( Left <$> takeEnv vcache ) + `orElse` ( Right <$> waitTSem envsem ) + case eenvpermission of + Right () -> maker + Left env -> do + -- Given our env, we check if it's dead. If it's not, we are done and return it. + -- If it is dead, we release it, signal that a new env can be created, and then recurse + isdead <- isDead env + if not isdead then return env + else do + killer env + atomically $ signalTSem envsem + go + +-- * Low level +initializeEmptyCache :: Int -> IO (VCache env) +initializeEmptyCache n | n < 1 = return mempty + | otherwise = Vector.replicateM n newEmptyTMVarIO + +takeEnv :: VCache env -> STM env +takeEnv = Vector.foldl folding retry + where folding m stmenv = m `orElse` takeTMVar stmenv + +tryTakeEnv :: VCache env -> STM (Maybe env) +tryTakeEnv cache = (Just <$> takeEnv cache) `orElse` pure Nothing + +putEnv :: VCache env -> env -> STM () +putEnv cache env = Vector.foldl folding retry cache + where folding m stmenv = m `orElse` putTMVar stmenv env + +tryPutEnv :: VCache env -> env -> STM Bool +tryPutEnv cache env = (putEnv cache env *> return True) `orElse` pure False + +releaseCache :: Cache env -> IO () +releaseCache cache = Vector.mapM_ qkRelease (vcache cache) + where qkRelease tenv = atomically (tryTakeTMVar tenv) + >>= maybe (return ()) (killer $ spawner cache) diff --git a/testsuite/tests/concurrent/should_run/T5611.stderr.mingw32 b/testsuite/tests/concurrent/should_run/T5611.stderr.mingw32 new file mode 100644 index 0000000000..c034e20430 --- /dev/null +++ b/testsuite/tests/concurrent/should_run/T5611.stderr.mingw32 @@ -0,0 +1 @@ +T5611: <stdout>: commitBuffer: user error (Exception delivered successfully) diff --git a/testsuite/tests/concurrent/should_run/all.T b/testsuite/tests/concurrent/should_run/all.T index 69b8ad7a1e..08f439c34e 100644 --- a/testsuite/tests/concurrent/should_run/all.T +++ b/testsuite/tests/concurrent/should_run/all.T @@ -40,8 +40,7 @@ test('T3429', [ extra_run_opts('+RTS -C0.001 -RTS'), compile_and_run, ['']) # without -O, goes into an infinite loop -# GHCi does not detect the infinite loop. We should really fix this. -test('T4030', omit_ways('ghci'), compile_and_run, ['-O']) +test('T4030', normal, compile_and_run, ['-O']) # each of these runs for about a second test('throwto001', [reqlib('random'), extra_run_opts('1000 2000')], @@ -119,10 +118,7 @@ setTestOpts(when(fast(), skip)) test('conc001', normal, compile_and_run, ['']) test('conc002', normal, compile_and_run, ['']) - -# Omit GHCi way - it blows up to 0.5G. Something to do with the threaded RTS? -test('conc004', omit_ways(['ghci']), compile_and_run, ['']) - +test('conc004', normal, compile_and_run, ['']) test('conc007', extra_run_opts('+RTS -H128M -RTS'), compile_and_run, ['']) test('conc008', normal, compile_and_run, ['']) test('conc009', exit_code(1), compile_and_run, ['']) @@ -158,7 +154,7 @@ else: conc023_ways = normal test('conc023', [when(fast(), skip), - reqlib('random'), + reqlib('random'), multi_cpu_race, conc023_ways], compile_and_run, ['']) test('conc024', normal, compile_and_run, ['']) @@ -284,3 +280,5 @@ test('hs_try_putmvar003', # Check forkIO exception determinism under optimization test('T13330', normal, compile_and_run, ['-O']) +test('T13916', [reqlib('vector'), reqlib('stm'), reqlib('async')], + compile_and_run, ['-O2']) diff --git a/testsuite/tests/concurrent/should_run/conc065.hs b/testsuite/tests/concurrent/should_run/conc065.hs index 8f6c18b79d..7e75381a26 100644 --- a/testsuite/tests/concurrent/should_run/conc065.hs +++ b/testsuite/tests/concurrent/should_run/conc065.hs @@ -4,7 +4,7 @@ import Control.Concurrent import Control.Exception -- This loop spends most of its time printing stuff, and very occasionally --- pops outside 'block'. This test ensures that an thread trying to +-- pops outside 'block'. This test ensures that a thread trying to -- throwTo this thread will eventually succeed. loop = mask_ (print "alive") >> loop diff --git a/testsuite/tests/concurrent/should_run/setnumcapabilities001.hs b/testsuite/tests/concurrent/should_run/setnumcapabilities001.hs index 27685f0894..a18d75aeef 100644 --- a/testsuite/tests/concurrent/should_run/setnumcapabilities001.hs +++ b/testsuite/tests/concurrent/should_run/setnumcapabilities001.hs @@ -15,7 +15,7 @@ main = do forM_ (cycle ([n,n-1..1] ++ [2..n-1])) $ \m -> do setNumCapabilities m threadDelay t - printf "%d" (nqueens q) + printf "%d\n" (nqueens q) killThread t -- If we don't kill the child thread, it might be about to -- call setNumCapabilities() in C when the main thread exits, @@ -34,7 +34,7 @@ nqueens nq = length (pargen 0 []) pargen :: Int -> [Int] -> [[Int]] pargen n b | n >= threshold = iterate gen [b] !! (nq - n) - | otherwise = concat bs + | otherwise = concat bs where bs = map (pargen (n+1)) (gen [b]) `using` parList rdeepseq threshold = 3 diff --git a/testsuite/tests/deSugar/should_compile/Makefile b/testsuite/tests/deSugar/should_compile/Makefile index 792d4e7bc9..4600070c05 100644 --- a/testsuite/tests/deSugar/should_compile/Makefile +++ b/testsuite/tests/deSugar/should_compile/Makefile @@ -5,12 +5,21 @@ include $(TOP)/mk/test.mk T5252: $(RM) -f T5252.hi T5252.o $(RM) -f T5252a.hi T5252a.o - '$(TEST_HC)' $(TEST_HC_OPTS) -c T5252a.hs + '$(TEST_HC)' $(TEST_HC_OPTS) -c T5252a.hs '$(TEST_HC)' $(TEST_HC_OPTS) -c T5252.hs # Failed when compiled *without* optimisation T5252Take2: $(RM) -f T5252Take2.hi T5252Take2.o $(RM) -f T5252Take2a.hi T5252Take2a.o - '$(TEST_HC)' $(TEST_HC_OPTS) -c T5252Take2a.hs + '$(TEST_HC)' $(TEST_HC_OPTS) -c T5252Take2a.hs '$(TEST_HC)' $(TEST_HC_OPTS) -c T5252Take2.hs + +T14815: + '$(TEST_HC)' $(TEST_HC_OPTS) T14815.hs -ddump-ds -dsuppress-uniques -ddump-to-file -dumpdir lazy -fforce-recomp + '$(TEST_HC)' $(TEST_HC_OPTS) T14815.hs -XStrict -ddump-ds -dsuppress-uniques -ddump-to-file -dumpdir strict -fforce-recomp + # Drop time stamps from both files + tail -n +5 lazy/T14815.dump-ds >lazy_out + tail -n +5 strict/T14815.dump-ds >strict_out + # Finally compare outputs + diff lazy_out strict_out -q diff --git a/testsuite/tests/deSugar/should_compile/T13870.hs b/testsuite/tests/deSugar/should_compile/T13870.hs new file mode 100644 index 0000000000..90ad9f072e --- /dev/null +++ b/testsuite/tests/deSugar/should_compile/T13870.hs @@ -0,0 +1,14 @@ +-- !!! T13870 -- missing-fields warnings for recprd-construction + +module ShouldCompile where + +import Data.Functor.Identity + +test1 :: Maybe Int +test1 = Just{} + +test2 :: Maybe Int +test2 = Nothing{} + +test3 :: Identity Int +test3 = Identity{} diff --git a/testsuite/tests/deSugar/should_compile/T13870.stderr b/testsuite/tests/deSugar/should_compile/T13870.stderr new file mode 100644 index 0000000000..55868069d3 --- /dev/null +++ b/testsuite/tests/deSugar/should_compile/T13870.stderr @@ -0,0 +1,10 @@ + +T13870.hs:8:9: warning: [-Wmissing-fields (in -Wdefault)] + • Fields of ‘Just’ not initialised + • In the expression: Just {} + In an equation for ‘test1’: test1 = Just {} + +T13870.hs:14:9: warning: [-Wmissing-fields (in -Wdefault)] + • Fields of ‘Identity’ not initialised: runIdentity + • In the expression: Identity {} + In an equation for ‘test3’: test3 = Identity {} diff --git a/testsuite/tests/deSugar/should_compile/T14135.hs b/testsuite/tests/deSugar/should_compile/T14135.hs new file mode 100644 index 0000000000..fbdd5bd4c6 --- /dev/null +++ b/testsuite/tests/deSugar/should_compile/T14135.hs @@ -0,0 +1,16 @@ +{-# LANGUAGE PatternSynonyms #-} +{-# OPTIONS_GHC -Wincomplete-patterns #-} +{-# LANGUAGE GADTs #-} +module T14135 where + +data Foo a where + Foo1 :: a -> Foo a + Foo2 :: Int -> Foo Int + +pattern MyFoo2 :: (a ~ Int) => Int -> Foo a +pattern MyFoo2 i = Foo2 i + +{-# COMPLETE Foo1, MyFoo2 #-} + +f :: Foo a -> a +f (Foo1 x) = x diff --git a/testsuite/tests/deSugar/should_compile/T14135.stderr b/testsuite/tests/deSugar/should_compile/T14135.stderr new file mode 100644 index 0000000000..23a3e90aaf --- /dev/null +++ b/testsuite/tests/deSugar/should_compile/T14135.stderr @@ -0,0 +1,4 @@ + +T14135.hs:16:1: warning: [-Wincomplete-patterns (in -Wextra)] + Pattern match(es) are non-exhaustive + In an equation for ‘f’: Patterns not matched: (Foo2 _) diff --git a/testsuite/tests/deSugar/should_compile/T14546a.hs b/testsuite/tests/deSugar/should_compile/T14546a.hs new file mode 100644 index 0000000000..085ea3ced9 --- /dev/null +++ b/testsuite/tests/deSugar/should_compile/T14546a.hs @@ -0,0 +1,29 @@ +main :: IO () +main = do + case 0::Int of + 0 -> putStrLn "A" + 1 -> putStrLn "B" + _ -> putStrLn "C" + + case 0::Int of + 0 -> putStrLn "A" + 1 -> putStrLn "B" + 2 -> putStrLn "C" + + case 0::Integer of + 0 -> putStrLn "A" + 1 -> putStrLn "B" + _ -> putStrLn "C" + + case 0::Integer of + 0 -> putStrLn "A" + 1 -> putStrLn "B" + 2 -> putStrLn "C" + + case 0::Integer of + 1 -> putStrLn "B" + 2 -> putStrLn "C" + + case 3::Integer of + 1 -> putStrLn "B" + 2 -> putStrLn "C" diff --git a/testsuite/tests/deSugar/should_compile/T14546a.stderr b/testsuite/tests/deSugar/should_compile/T14546a.stderr new file mode 100644 index 0000000000..5918a45cc7 --- /dev/null +++ b/testsuite/tests/deSugar/should_compile/T14546a.stderr @@ -0,0 +1,56 @@ + +T14546a.hs:5:7: warning: [-Woverlapping-patterns (in -Wdefault)] + Pattern match is redundant + In a case alternative: 1 -> ... + +T14546a.hs:6:7: warning: [-Woverlapping-patterns (in -Wdefault)] + Pattern match is redundant + In a case alternative: _ -> ... + +T14546a.hs:10:7: warning: [-Woverlapping-patterns (in -Wdefault)] + Pattern match is redundant + In a case alternative: 1 -> ... + +T14546a.hs:11:7: warning: [-Woverlapping-patterns (in -Wdefault)] + Pattern match is redundant + In a case alternative: 2 -> ... + +T14546a.hs:15:7: warning: [-Woverlapping-patterns (in -Wdefault)] + Pattern match is redundant + In a case alternative: 1 -> ... + +T14546a.hs:16:7: warning: [-Woverlapping-patterns (in -Wdefault)] + Pattern match is redundant + In a case alternative: _ -> ... + +T14546a.hs:20:7: warning: [-Woverlapping-patterns (in -Wdefault)] + Pattern match is redundant + In a case alternative: 1 -> ... + +T14546a.hs:21:7: warning: [-Woverlapping-patterns (in -Wdefault)] + Pattern match is redundant + In a case alternative: 2 -> ... + +T14546a.hs:23:4: warning: [-Wincomplete-patterns (in -Wextra)] + Pattern match(es) are non-exhaustive + In a case alternative: Patterns not matched: 0 + +T14546a.hs:24:7: warning: [-Woverlapping-patterns (in -Wdefault)] + Pattern match is redundant + In a case alternative: 1 -> ... + +T14546a.hs:25:7: warning: [-Woverlapping-patterns (in -Wdefault)] + Pattern match is redundant + In a case alternative: 2 -> ... + +T14546a.hs:27:4: warning: [-Wincomplete-patterns (in -Wextra)] + Pattern match(es) are non-exhaustive + In a case alternative: Patterns not matched: 3 + +T14546a.hs:28:7: warning: [-Woverlapping-patterns (in -Wdefault)] + Pattern match is redundant + In a case alternative: 1 -> ... + +T14546a.hs:29:7: warning: [-Woverlapping-patterns (in -Wdefault)] + Pattern match is redundant + In a case alternative: 2 -> ... diff --git a/testsuite/tests/deSugar/should_compile/T14546b.hs b/testsuite/tests/deSugar/should_compile/T14546b.hs new file mode 100644 index 0000000000..7dd0b23384 --- /dev/null +++ b/testsuite/tests/deSugar/should_compile/T14546b.hs @@ -0,0 +1,11 @@ +main :: IO () +main = do + case "foo" of + ('f':_) -> putStrLn "A" + ('f':'o':_) -> putStrLn "B" + "bar" -> putStrLn "C" + + case "foo" of + "foo" -> putStrLn "A" + "bar" -> putStrLn "B" + "baz" -> putStrLn "C" diff --git a/testsuite/tests/deSugar/should_compile/T14546b.stderr b/testsuite/tests/deSugar/should_compile/T14546b.stderr new file mode 100644 index 0000000000..00b4286a48 --- /dev/null +++ b/testsuite/tests/deSugar/should_compile/T14546b.stderr @@ -0,0 +1,16 @@ + +T14546b.hs:5:7: warning: [-Woverlapping-patterns (in -Wdefault)] + Pattern match is redundant + In a case alternative: ('f' : 'o' : _) -> ... + +T14546b.hs:6:7: warning: [-Woverlapping-patterns (in -Wdefault)] + Pattern match is redundant + In a case alternative: "bar" -> ... + +T14546b.hs:10:7: warning: [-Woverlapping-patterns (in -Wdefault)] + Pattern match is redundant + In a case alternative: "bar" -> ... + +T14546b.hs:11:7: warning: [-Woverlapping-patterns (in -Wdefault)] + Pattern match is redundant + In a case alternative: "baz" -> ... diff --git a/testsuite/tests/deSugar/should_compile/T14546c.hs b/testsuite/tests/deSugar/should_compile/T14546c.hs new file mode 100644 index 0000000000..886511b65a --- /dev/null +++ b/testsuite/tests/deSugar/should_compile/T14546c.hs @@ -0,0 +1,20 @@ +{-# LANGUAGE OverloadedStrings #-} + +import qualified Data.ByteString as B + +main :: IO () +main = do + case "foo" of + ('f':_) -> putStrLn "A" + ('f':'o':_) -> putStrLn "B" + "bar" -> putStrLn "C" + + case "foo" of + "foo" -> putStrLn "A" + "bar" -> putStrLn "B" + "baz" -> putStrLn "C" + + case ("foo" :: B.ByteString) of + "foo" -> putStrLn "A" + "bar" -> putStrLn "B" + "baz" -> putStrLn "C" diff --git a/testsuite/tests/deSugar/should_compile/T14546c.stderr b/testsuite/tests/deSugar/should_compile/T14546c.stderr new file mode 100644 index 0000000000..0ea6ca0012 --- /dev/null +++ b/testsuite/tests/deSugar/should_compile/T14546c.stderr @@ -0,0 +1,24 @@ + +T14546c.hs:9:7: warning: [-Woverlapping-patterns (in -Wdefault)] + Pattern match is redundant + In a case alternative: ('f' : 'o' : _) -> ... + +T14546c.hs:10:7: warning: [-Woverlapping-patterns (in -Wdefault)] + Pattern match is redundant + In a case alternative: "bar" -> ... + +T14546c.hs:14:7: warning: [-Woverlapping-patterns (in -Wdefault)] + Pattern match is redundant + In a case alternative: "bar" -> ... + +T14546c.hs:15:7: warning: [-Woverlapping-patterns (in -Wdefault)] + Pattern match is redundant + In a case alternative: "baz" -> ... + +T14546c.hs:19:7: warning: [-Woverlapping-patterns (in -Wdefault)] + Pattern match is redundant + In a case alternative: "bar" -> ... + +T14546c.hs:20:7: warning: [-Woverlapping-patterns (in -Wdefault)] + Pattern match is redundant + In a case alternative: "baz" -> ... diff --git a/testsuite/tests/deSugar/should_compile/T14547.hs b/testsuite/tests/deSugar/should_compile/T14547.hs new file mode 100644 index 0000000000..02ff2e618c --- /dev/null +++ b/testsuite/tests/deSugar/should_compile/T14547.hs @@ -0,0 +1,15 @@ +{-# LANGUAGE OverloadedLists #-} +{-# LANGUAGE TypeFamilies #-} + +module T14547 where + +class Foo f where + type It f + foo :: [It f] -> f + +data List a = Empty | a :! List a deriving Show + +instance Foo (List a) where + type It (List a) = a + foo [] = Empty + foo (x : xs) = x :! foo xs diff --git a/testsuite/tests/deSugar/should_compile/T14773a.hs b/testsuite/tests/deSugar/should_compile/T14773a.hs new file mode 100644 index 0000000000..6d1e9fca5d --- /dev/null +++ b/testsuite/tests/deSugar/should_compile/T14773a.hs @@ -0,0 +1,10 @@ +{-# LANGUAGE MultiWayIf #-} + +module T14773a where + +foo :: Bool -> Int +foo b = if | b -> 1 + +bar :: Bool -> Int +bar b = if | b -> 1 + | otherwise -> 2 diff --git a/testsuite/tests/deSugar/should_compile/T14773a.stderr b/testsuite/tests/deSugar/should_compile/T14773a.stderr new file mode 100644 index 0000000000..49d1ef05fc --- /dev/null +++ b/testsuite/tests/deSugar/should_compile/T14773a.stderr @@ -0,0 +1,5 @@ + +T14773a.hs:6:12: warning: [-Wincomplete-patterns (in -Wextra)] + Pattern match(es) are non-exhaustive + In a multi-way if alternative: + Guards do not cover entire pattern space diff --git a/testsuite/tests/deSugar/should_compile/T14773b.hs b/testsuite/tests/deSugar/should_compile/T14773b.hs new file mode 100644 index 0000000000..d11bbfe5d5 --- /dev/null +++ b/testsuite/tests/deSugar/should_compile/T14773b.hs @@ -0,0 +1,8 @@ +module T14773b where + +b :: Bool +(Just b) | False = Nothing + +c :: Bool +(Just c) | False = Nothing + | True = Just True diff --git a/testsuite/tests/deSugar/should_compile/T14773b.stderr b/testsuite/tests/deSugar/should_compile/T14773b.stderr new file mode 100644 index 0000000000..557b10b8f0 --- /dev/null +++ b/testsuite/tests/deSugar/should_compile/T14773b.stderr @@ -0,0 +1,5 @@ + +T14773b.hs:4:10: warning: [-Wincomplete-patterns (in -Wextra)] + Pattern match(es) are non-exhaustive + In a pattern binding guards: + Guards do not cover entire pattern space diff --git a/testsuite/tests/deSugar/should_compile/T14815.hs b/testsuite/tests/deSugar/should_compile/T14815.hs new file mode 100644 index 0000000000..fc5a6ee26e --- /dev/null +++ b/testsuite/tests/deSugar/should_compile/T14815.hs @@ -0,0 +1,43 @@ +-- Desugarer outputs of this program when compiled with and without -XStrict +-- should be the same because this program has only one binder (`a` in function +-- `primitive`), but the binder is annotated with a laziness annotation, so +-- -XStrict should have no effect on that binder. +-- +-- Derived methods are also effected by -XStrict, but in our case we derive via +-- GND which just generates coercions like +-- +-- instance Functor m => Functor (StateT s m) where +-- fmap +-- = coerce +-- @(forall (a_aJ2 :: TYPE LiftedRep) (b_aJ3 :: TYPE LiftedRep). +-- a_aJ2 -> b_aJ3 +-- -> StateT s_aDW m_aDX a_aJ2 -> StateT s_aDW m_aDX b_aJ3) +-- @(forall (a_aJ2 :: TYPE LiftedRep) (b_aJ3 :: TYPE LiftedRep). +-- a_aJ2 -> b_aJ3 +-- -> StateT s_aDW m_aDX a_aJ2 -> StateT s_aDW m_aDX b_aJ3) +-- fmap +-- +-- So really -XStrict shouldn't have any effect on this program. + +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE UnboxedTuples #-} + +module K where + +import qualified Control.Monad.State.Strict as S +import Control.Monad.Trans +import GHC.Exts + +class Monad m => PrimMonad m where + type PrimState m + primitive :: (State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a + +newtype StateT s m a = StateT (S.StateT s m a) + deriving (Functor, Applicative, Monad, MonadTrans) + +instance PrimMonad m => PrimMonad (StateT s m) where + type PrimState (StateT s m) = PrimState m + primitive ~a = lift (primitive a) ; {-# INLINE primitive #-} diff --git a/testsuite/tests/deSugar/should_compile/T14815.stdout b/testsuite/tests/deSugar/should_compile/T14815.stdout new file mode 100644 index 0000000000..f51afc4f54 --- /dev/null +++ b/testsuite/tests/deSugar/should_compile/T14815.stdout @@ -0,0 +1,2 @@ +[1 of 1] Compiling K ( T14815.hs, T14815.o ) +[1 of 1] Compiling K ( T14815.hs, T14815.o ) diff --git a/testsuite/tests/deSugar/should_compile/T2431.stderr b/testsuite/tests/deSugar/should_compile/T2431.stderr index aaa1696331..3c1c232887 100644 --- a/testsuite/tests/deSugar/should_compile/T2431.stderr +++ b/testsuite/tests/deSugar/should_compile/T2431.stderr @@ -11,60 +11,58 @@ T2431.$WRefl [InlPrag=INLINE[2]] :: forall a. a :~: a Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=ALWAYS_IF(arity=0,unsat_ok=True,boring_ok=False) - Tmpl= \ (@ a) -> - T2431.Refl @ a @ a @~ (<a>_N :: (a :: *) GHC.Prim.~# (a :: *))}] + Tmpl= \ (@ a) -> T2431.Refl @ a @ a @~ (<a>_N :: a GHC.Prim.~# a)}] T2431.$WRefl - = \ (@ a) -> - T2431.Refl @ a @ a @~ (<a>_N :: (a :: *) GHC.Prim.~# (a :: *)) + = \ (@ a) -> T2431.Refl @ a @ a @~ (<a>_N :: a GHC.Prim.~# a) -- RHS size: {terms: 4, types: 8, coercions: 0, joins: 0/0} absurd :: forall a. (Int :~: Bool) -> a -[GblId, Arity=1, Caf=NoCafRefs, Str=<L,U>x] +[GblId, Arity=1, Caf=NoCafRefs, Str=<L,U>x, Unf=OtherCon []] absurd = \ (@ a) (x :: Int :~: Bool) -> case x of { } -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} $trModule1 :: GHC.Prim.Addr# -[GblId, Caf=NoCafRefs] +[GblId, Caf=NoCafRefs, Unf=OtherCon []] $trModule1 = "main"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} $trModule2 :: GHC.Types.TrName -[GblId, Caf=NoCafRefs] +[GblId, Caf=NoCafRefs, Unf=OtherCon []] $trModule2 = GHC.Types.TrNameS $trModule1 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} $trModule3 :: GHC.Prim.Addr# -[GblId, Caf=NoCafRefs] +[GblId, Caf=NoCafRefs, Unf=OtherCon []] $trModule3 = "T2431"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} $trModule4 :: GHC.Types.TrName -[GblId, Caf=NoCafRefs] +[GblId, Caf=NoCafRefs, Unf=OtherCon []] $trModule4 = GHC.Types.TrNameS $trModule3 -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} T2431.$trModule :: GHC.Types.Module -[GblId, Caf=NoCafRefs] +[GblId, Caf=NoCafRefs, Unf=OtherCon []] T2431.$trModule = GHC.Types.Module $trModule2 $trModule4 -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} $krep :: GHC.Types.KindRep -[GblId, Caf=NoCafRefs] +[GblId, Caf=NoCafRefs, Unf=OtherCon []] $krep = GHC.Types.KindRepVar 0# -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} $tc:~:1 :: GHC.Prim.Addr# -[GblId, Caf=NoCafRefs] +[GblId, Caf=NoCafRefs, Unf=OtherCon []] $tc:~:1 = ":~:"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} $tc:~:2 :: GHC.Types.TrName -[GblId, Caf=NoCafRefs] +[GblId, Caf=NoCafRefs, Unf=OtherCon []] $tc:~:2 = GHC.Types.TrNameS $tc:~:1 -- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} T2431.$tc:~: :: GHC.Types.TyCon -[GblId] +[GblId, Unf=OtherCon []] T2431.$tc:~: = GHC.Types.TyCon 4608886815921030019## @@ -76,34 +74,34 @@ T2431.$tc:~: -- RHS size: {terms: 3, types: 2, coercions: 0, joins: 0/0} $krep1 :: [GHC.Types.KindRep] -[GblId, Caf=NoCafRefs] +[GblId, Caf=NoCafRefs, Unf=OtherCon []] $krep1 = GHC.Types.: @ GHC.Types.KindRep $krep (GHC.Types.[] @ GHC.Types.KindRep) -- RHS size: {terms: 3, types: 1, coercions: 0, joins: 0/0} $krep2 :: [GHC.Types.KindRep] -[GblId, Caf=NoCafRefs] +[GblId, Caf=NoCafRefs, Unf=OtherCon []] $krep2 = GHC.Types.: @ GHC.Types.KindRep $krep $krep1 -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} $krep3 :: GHC.Types.KindRep -[GblId] +[GblId, Unf=OtherCon []] $krep3 = GHC.Types.KindRepTyConApp T2431.$tc:~: $krep2 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} $tc'Refl1 :: GHC.Prim.Addr# -[GblId, Caf=NoCafRefs] +[GblId, Caf=NoCafRefs, Unf=OtherCon []] $tc'Refl1 = "'Refl"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} $tc'Refl2 :: GHC.Types.TrName -[GblId, Caf=NoCafRefs] +[GblId, Caf=NoCafRefs, Unf=OtherCon []] $tc'Refl2 = GHC.Types.TrNameS $tc'Refl1 -- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} T2431.$tc'Refl :: GHC.Types.TyCon -[GblId] +[GblId, Unf=OtherCon []] T2431.$tc'Refl = GHC.Types.TyCon 2478588351447975921## diff --git a/testsuite/tests/deSugar/should_compile/all.T b/testsuite/tests/deSugar/should_compile/all.T index 7a39b1eed7..9951047e99 100644 --- a/testsuite/tests/deSugar/should_compile/all.T +++ b/testsuite/tests/deSugar/should_compile/all.T @@ -98,3 +98,12 @@ test('T13043', normal, compile, ['']) test('T13215', normal, compile, ['']) test('T13290', normal, compile, ['']) test('T13257', normal, compile, ['']) +test('T13870', normal, compile, ['']) +test('T14135', normal, compile, ['']) +test('T14546a', normal, compile, ['-Wincomplete-patterns']) +test('T14546b', normal, compile, ['-Wincomplete-patterns']) +test('T14546c', normal, compile, ['-Wincomplete-patterns']) +test('T14547', normal, compile, ['-Wincomplete-patterns']) +test('T14773a', normal, compile, ['-Wincomplete-patterns']) +test('T14773b', normal, compile, ['-Wincomplete-patterns']) +test('T14815', [], run_command, ['$MAKE -s --no-print-directory T14815']) diff --git a/testsuite/tests/deSugar/should_fail/DsStrictFail.stderr b/testsuite/tests/deSugar/should_fail/DsStrictFail.stderr index c7135b2a27..a863168277 100644 --- a/testsuite/tests/deSugar/should_fail/DsStrictFail.stderr +++ b/testsuite/tests/deSugar/should_fail/DsStrictFail.stderr @@ -1,2 +1,2 @@ -DsStrictFail: DsStrictFail.hs:4:12-23: Irrefutable pattern failed for pattern False +DsStrictFail: DsStrictFail.hs:4:12-23: Non-exhaustive patterns in False diff --git a/testsuite/tests/deSugar/should_run/all.T b/testsuite/tests/deSugar/should_run/all.T index c289c013b0..757d817a0c 100644 --- a/testsuite/tests/deSugar/should_run/all.T +++ b/testsuite/tests/deSugar/should_run/all.T @@ -16,7 +16,9 @@ test('dsrun010', normal, compile_and_run, ['']) test('dsrun011', when(fast(), skip), compile_and_run, ['']) test('dsrun012', when(fast(), skip), compile_and_run, ['']) test('dsrun013', normal, compile_and_run, ['']) -test('dsrun014', normal, compile_and_run, ['-fobject-code']) +test('dsrun014', expect_broken_for(14901, + ['hpc', 'dyn', 'optasm', 'optllvm', 'threaded2'] + ), compile_and_run, ['-fobject-code']) test('dsrun015', normal, compile_and_run, ['']) test('dsrun016', normal, compile_and_run, ['']) test('dsrun017', normal, compile_and_run, ['']) diff --git a/testsuite/tests/deSugar/should_run/dsrun008.stderr b/testsuite/tests/deSugar/should_run/dsrun008.stderr index ff7de054f2..cef2458b1e 100644 --- a/testsuite/tests/deSugar/should_run/dsrun008.stderr +++ b/testsuite/tests/deSugar/should_run/dsrun008.stderr @@ -1,2 +1,2 @@ -dsrun008: dsrun008.hs:2:15-42: Irrefutable pattern failed for pattern (2, x) +dsrun008: dsrun008.hs:2:15-42: Non-exhaustive patterns in (2, x) diff --git a/testsuite/tests/deSugar/should_run/dsrun010.hs b/testsuite/tests/deSugar/should_run/dsrun010.hs index 4b8bf4e1bc..5657fb7526 100644 --- a/testsuite/tests/deSugar/should_run/dsrun010.hs +++ b/testsuite/tests/deSugar/should_run/dsrun010.hs @@ -2,6 +2,8 @@ -- is reflected by calling the monadic 'fail', not by a -- runtime exception +{-# LANGUAGE NoMonadFailDesugaring #-} + import Control.Monad import Data.Maybe diff --git a/testsuite/tests/dependent/ghci/T11549.script b/testsuite/tests/dependent/ghci/T11549.script index bb35589671..3e0811f921 100644 --- a/testsuite/tests/dependent/ghci/T11549.script +++ b/testsuite/tests/dependent/ghci/T11549.script @@ -1,14 +1,18 @@ -:set -XTypeInType +:set -XPolyKinds import GHC.Exts putStrLn "-fno-print-explicit-runtime-reps" :set -fno-print-explicit-runtime-reps +:type ($) :info ($) :kind TYPE +:type error :info error putStrLn "\n-fprint-explicit-runtime-reps" :set -fprint-explicit-runtime-reps +:type ($) :info ($) :kind TYPE +:type error :info error diff --git a/testsuite/tests/dependent/ghci/T11549.stdout b/testsuite/tests/dependent/ghci/T11549.stdout index c8449ba09f..5e23c0da99 100644 --- a/testsuite/tests/dependent/ghci/T11549.stdout +++ b/testsuite/tests/dependent/ghci/T11549.stdout @@ -1,12 +1,21 @@ -fno-print-explicit-runtime-reps ($) :: (a -> b) -> a -> b +($) :: (a -> b) -> a -> b -- Defined in ‘GHC.Base’ +infixr 0 $ TYPE :: RuntimeRep -> * +error :: [Char] -> a error :: GHC.Stack.Types.HasCallStack => [Char] -> a + -- Defined in ‘GHC.Err’ -fprint-explicit-runtime-reps +($) :: (a -> b) -> a -> b ($) :: forall (r :: RuntimeRep) a (b :: TYPE r). (a -> b) -> a -> b + -- Defined in ‘GHC.Base’ +infixr 0 $ TYPE :: RuntimeRep -> * -error - :: forall (r :: RuntimeRep) (a :: TYPE r). - GHC.Stack.Types.HasCallStack => - [Char] -> a +error :: [Char] -> a +error :: + forall (r :: RuntimeRep) (a :: TYPE r). + GHC.Stack.Types.HasCallStack => + [Char] -> a + -- Defined in ‘GHC.Err’ diff --git a/testsuite/tests/dependent/ghci/T11786.script b/testsuite/tests/dependent/ghci/T11786.script new file mode 100644 index 0000000000..61e3141843 --- /dev/null +++ b/testsuite/tests/dependent/ghci/T11786.script @@ -0,0 +1,11 @@ +:set -fno-print-explicit-runtime-reps +:t ($) +:t (($)) +:t +v ($) +:i ($) + +:set -fprint-explicit-runtime-reps +:t ($) +:t (($)) +:t +v ($) +:i ($) diff --git a/testsuite/tests/dependent/ghci/T11786.stdout b/testsuite/tests/dependent/ghci/T11786.stdout new file mode 100644 index 0000000000..93616ed750 --- /dev/null +++ b/testsuite/tests/dependent/ghci/T11786.stdout @@ -0,0 +1,15 @@ +($) :: (a -> b) -> a -> b +(($)) :: (a -> b) -> a -> b +($) :: (a -> b) -> a -> b +($) :: (a -> b) -> a -> b -- Defined in ‘GHC.Base’ +infixr 0 $ +($) :: (a -> b) -> a -> b +(($)) :: (a -> b) -> a -> b +($) + :: forall (r :: GHC.Types.RuntimeRep) a (b :: TYPE r). + (a -> b) -> a -> b +($) :: + forall (r :: GHC.Types.RuntimeRep) a (b :: TYPE r). + (a -> b) -> a -> b + -- Defined in ‘GHC.Base’ +infixr 0 $ diff --git a/testsuite/tests/dependent/ghci/T14238.script b/testsuite/tests/dependent/ghci/T14238.script new file mode 100644 index 0000000000..7c27123e00 --- /dev/null +++ b/testsuite/tests/dependent/ghci/T14238.script @@ -0,0 +1,4 @@ +:set -XTypeInType +:m + Data.Kind +data Foo (k :: Type) :: k -> Type +:kind Foo diff --git a/testsuite/tests/dependent/ghci/T14238.stdout b/testsuite/tests/dependent/ghci/T14238.stdout new file mode 100644 index 0000000000..fddbc0de54 --- /dev/null +++ b/testsuite/tests/dependent/ghci/T14238.stdout @@ -0,0 +1 @@ +Foo :: forall k -> k -> * diff --git a/testsuite/tests/dependent/ghci/all.T b/testsuite/tests/dependent/ghci/all.T index 956272fa55..89ebab0e44 100644 --- a/testsuite/tests/dependent/ghci/all.T +++ b/testsuite/tests/dependent/ghci/all.T @@ -1,4 +1,3 @@ -test('T11549', - [ expect_broken( 11787 ), - expect_broken( 11786 ) ], - ghci_script, ['T11549.script']) +test('T11549', normal, ghci_script, ['T11549.script']) +test('T11786', normal, ghci_script, ['T11786.script']) +test('T14238', normal, ghci_script, ['T14238.script']) diff --git a/testsuite/tests/dependent/should_compile/Dep1.hs b/testsuite/tests/dependent/should_compile/Dep1.hs index 6f8fe0720d..086d759bbe 100644 --- a/testsuite/tests/dependent/should_compile/Dep1.hs +++ b/testsuite/tests/dependent/should_compile/Dep1.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE TypeInType #-} +{-# LANGUAGE DataKinds, PolyKinds #-} module Dep1 where diff --git a/testsuite/tests/dependent/should_compile/Dep3.hs b/testsuite/tests/dependent/should_compile/Dep3.hs index cba5043a08..db10d2a8c6 100644 --- a/testsuite/tests/dependent/should_compile/Dep3.hs +++ b/testsuite/tests/dependent/should_compile/Dep3.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE TypeFamilies, TypeInType, GADTs #-} +{-# LANGUAGE TypeFamilies, DataKinds, PolyKinds, GADTs #-} module Dep3 where diff --git a/testsuite/tests/dependent/should_compile/DkNameRes.hs b/testsuite/tests/dependent/should_compile/DkNameRes.hs new file mode 100644 index 0000000000..4110b33882 --- /dev/null +++ b/testsuite/tests/dependent/should_compile/DkNameRes.hs @@ -0,0 +1,9 @@ +{-# LANGUAGE TypeFamilies, DataKinds, PolyKinds #-} + +module DkNameRes where + +import Data.Proxy +import Data.Kind + +type family IfK (e :: Proxy (j :: Bool)) :: Type where + IfK (_ :: Proxy True) = () diff --git a/testsuite/tests/dependent/should_compile/KindEqualities.hs b/testsuite/tests/dependent/should_compile/KindEqualities.hs index 1f2e82c302..1caa46f7c3 100644 --- a/testsuite/tests/dependent/should_compile/KindEqualities.hs +++ b/testsuite/tests/dependent/should_compile/KindEqualities.hs @@ -3,6 +3,8 @@ module KindEqualities where +import Data.Kind + data TyRep1 :: * -> * where TyInt1 :: TyRep1 Int TyBool1 :: TyRep1 Bool @@ -13,7 +15,7 @@ zero1 TyBool1 = False data Proxy (a :: k) = P -data TyRep :: k -> * where +data TyRep :: forall k. k -> * where TyInt :: TyRep Int TyBool :: TyRep Bool TyMaybe :: TyRep Maybe diff --git a/testsuite/tests/dependent/should_compile/KindEqualities.stderr b/testsuite/tests/dependent/should_compile/KindEqualities.stderr index af429d106b..ad9562eae8 100644 --- a/testsuite/tests/dependent/should_compile/KindEqualities.stderr +++ b/testsuite/tests/dependent/should_compile/KindEqualities.stderr @@ -1,5 +1,5 @@ -KindEqualities.hs:23:1: warning: [-Wincomplete-patterns (in -Wextra)] +KindEqualities.hs:25:1: warning: [-Wincomplete-patterns (in -Wextra)] Pattern match(es) are non-exhaustive In an equation for ‘zero’: Patterns not matched: (TyApp (TyApp _ _) _) diff --git a/testsuite/tests/dependent/should_compile/KindEqualities2.hs b/testsuite/tests/dependent/should_compile/KindEqualities2.hs index 5a6f60d40b..0bdfcfa034 100644 --- a/testsuite/tests/dependent/should_compile/KindEqualities2.hs +++ b/testsuite/tests/dependent/should_compile/KindEqualities2.hs @@ -1,6 +1,5 @@ {-# LANGUAGE DataKinds, GADTs, PolyKinds, TypeFamilies, ExplicitForAll, - TemplateHaskell, UndecidableInstances, ScopedTypeVariables, - TypeInType #-} + TemplateHaskell, UndecidableInstances, ScopedTypeVariables #-} module KindEqualities2 where diff --git a/testsuite/tests/dependent/should_compile/KindLevels.hs b/testsuite/tests/dependent/should_compile/KindLevels.hs index 1aad299df3..5540ce40cd 100644 --- a/testsuite/tests/dependent/should_compile/KindLevels.hs +++ b/testsuite/tests/dependent/should_compile/KindLevels.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE TypeInType #-} +{-# LANGUAGE DataKinds, PolyKinds #-} module KindLevels where diff --git a/testsuite/tests/dependent/should_compile/Makefile b/testsuite/tests/dependent/should_compile/Makefile index 9101fbd40a..0f855180c0 100644 --- a/testsuite/tests/dependent/should_compile/Makefile +++ b/testsuite/tests/dependent/should_compile/Makefile @@ -1,3 +1,8 @@ TOP=../../.. include $(TOP)/mk/boilerplate.mk include $(TOP)/mk/test.mk + +T13938: + $(RM) T13938a.hi T13938a.o T13938.hi T13938.o + '$(TEST_HC)' $(TEST_HC_OPTS) -O -c T13938a.hs + '$(TEST_HC)' $(TEST_HC_OPTS) -O -c T13938.hs diff --git a/testsuite/tests/dependent/should_compile/RAE_T32b.hs b/testsuite/tests/dependent/should_compile/RAE_T32b.hs index 7e067099c9..ddd21db18d 100644 --- a/testsuite/tests/dependent/should_compile/RAE_T32b.hs +++ b/testsuite/tests/dependent/should_compile/RAE_T32b.hs @@ -1,23 +1,27 @@ {-# LANGUAGE TemplateHaskell, TypeFamilies, GADTs, DataKinds, PolyKinds, - RankNTypes, TypeOperators, TypeInType #-} + RankNTypes, TypeOperators #-} module RAE_T32b where import Data.Kind -data family Sing (k :: *) :: k -> * +data family Sing (k :: Type) :: k -> Type -data TyArr (a :: *) (b :: *) :: * -type family (a :: TyArr k1 k2 -> *) @@ (b :: k1) :: k2 +data TyArr (a :: Type) (b :: Type) :: Type +type family (a :: TyArr k1 k2 -> Type) @@ (b :: k1) :: k2 $(return []) -data Sigma (p :: *) (r :: TyArr p * -> *) :: * where - Sigma :: forall (p :: *) (r :: TyArr p * -> *) (a :: p) (b :: r @@ a). - Sing * p -> Sing (TyArr p * -> *) r -> Sing p a -> Sing (r @@ a) b -> Sigma p r +data Sigma (p :: Type) (r :: TyArr p Type -> Type) :: Type where + Sigma :: forall (p :: Type) (r :: TyArr p Type -> Type) + (a :: p) (b :: r @@ a). + Sing Type p -> Sing (TyArr p Type -> Type) r -> Sing p a -> + Sing (r @@ a) b -> Sigma p r $(return []) -data instance Sing (Sigma p r) (x :: Sigma p r) :: * where - SSigma :: forall (p :: *) (r :: TyArr p * -> *) (a :: p) (b :: r @@ a) - (sp :: Sing * p) (sr :: Sing (TyArr p * -> *) r) (sa :: Sing p a) (sb :: Sing (r @@ a) b). +data instance Sing (Sigma p r) (x :: Sigma p r) :: Type where + SSigma :: forall (p :: Type) (r :: TyArr p Type -> Type) + (a :: p) (b :: r @@ a) + (sp :: Sing Type p) (sr :: Sing (TyArr p Type -> Type) r) + (sa :: Sing p a) (sb :: Sing (r @@ a) b). Sing (Sing (r @@ a) b) sb -> Sing (Sigma p r) ('Sigma sp sr sa sb) diff --git a/testsuite/tests/dependent/should_compile/Rae31.hs b/testsuite/tests/dependent/should_compile/Rae31.hs index cedc019cf3..7a50b606ee 100644 --- a/testsuite/tests/dependent/should_compile/Rae31.hs +++ b/testsuite/tests/dependent/should_compile/Rae31.hs @@ -1,24 +1,27 @@ {-# LANGUAGE TemplateHaskell, TypeOperators, PolyKinds, DataKinds, - TypeFamilies, TypeInType #-} + TypeFamilies #-} module A where import Data.Kind -data family Sing (k :: *) :: k -> * +data family Sing (k :: Type) :: k -> Type type Sing' (x :: k) = Sing k x -data TyFun' (a :: *) (b :: *) :: * -type TyFun (a :: *) (b :: *) = TyFun' a b -> * +data TyFun' (a :: Type) (b :: Type) :: Type +type TyFun (a :: Type) (b :: Type) = TyFun' a b -> Type type family (a :: TyFun k1 k2) @@ (b :: k1) :: k2 -data TyPi' (a :: *) (b :: TyFun a *) :: * -type TyPi (a :: *) (b :: TyFun a *) = TyPi' a b -> * +data TyPi' (a :: Type) (b :: TyFun a Type) :: Type +type TyPi (a :: Type) (b :: TyFun a Type) = TyPi' a b -> Type type family (a :: TyPi k1 k2) @@@ (b :: k1) :: k2 @@ b $(return []) -data A (a :: *) (b :: a) (c :: TyFun' a *) -- A :: forall a -> a -> a ~> * -type instance (@@) (A a b) c = * +data A (a :: Type) (b :: a) (c :: TyFun' a Type) + -- A :: forall a -> a -> a ~> Type +type instance (@@) (A a b) c = Type $(return []) -data B (a :: *) (b :: TyFun' a *) -- B :: forall a -> a ~> * +data B (a :: Type) (b :: TyFun' a Type) + -- B :: forall a -> a ~> Type type instance (@@) (B a) b = TyPi a (A a b) $(return []) -data C (a :: *) (b :: TyPi a (B a)) (c :: a) (d :: a) (e :: TyFun' (b @@@ c @@@ d) *) +data C (a :: Type) (b :: TyPi a (B a)) (c :: a) (d :: a) + (e :: TyFun' (b @@@ c @@@ d) Type) diff --git a/testsuite/tests/dependent/should_compile/RaeBlogPost.hs b/testsuite/tests/dependent/should_compile/RaeBlogPost.hs index e99c7b5dd5..b048a49e44 100644 --- a/testsuite/tests/dependent/should_compile/RaeBlogPost.hs +++ b/testsuite/tests/dependent/should_compile/RaeBlogPost.hs @@ -1,5 +1,4 @@ -{-# LANGUAGE DataKinds, PolyKinds, GADTs, TypeOperators, TypeFamilies, - TypeInType #-} +{-# LANGUAGE DataKinds, PolyKinds, GADTs, TypeOperators, TypeFamilies #-} {-# OPTIONS_GHC -fwarn-unticked-promoted-constructors #-} module RaeBlogPost where @@ -8,7 +7,7 @@ import Data.Kind -- a Proxy type with an explicit kind data Proxy k (a :: k) = P -prox :: Proxy * Bool +prox :: Proxy Type Bool prox = P prox2 :: Proxy Bool 'True @@ -16,11 +15,11 @@ prox2 = P -- implicit kinds still work data A -data B :: A -> * -data C :: B a -> * -data D :: C b -> * -data E :: D c -> * --- note that E :: forall (a :: A) (b :: B a) (c :: C b). D c -> * +data B :: A -> Type +data C :: B a -> Type +data D :: C b -> Type +data E :: D c -> Type +-- note that E :: forall (a :: A) (b :: B a) (c :: C b). D c -> Type -- a kind-indexed GADT data TypeRep (a :: k) where @@ -37,7 +36,7 @@ type family a + b where 'Zero + b = b ('Succ a) + b = 'Succ (a + b) -data Vec :: * -> Nat -> * where +data Vec :: Type -> Nat -> Type where Nil :: Vec a 'Zero (:>) :: a -> Vec a n -> Vec a ('Succ n) infixr 5 :> @@ -47,17 +46,17 @@ type family (x :: Vec a n) ++ (y :: Vec a m) :: Vec a (n + m) where 'Nil ++ y = y (h ':> t) ++ y = h ':> (t ++ y) --- datatype that mentions * -data U = Star (*) +-- datatype that mentions Type +data U = Star (Type) | Bool Bool -- kind synonym -type Monadish = * -> * +type Monadish = Type -> Type class MonadTrans (t :: Monadish -> Monadish) where lift :: Monad m => m a -> t m a data Free :: Monadish where Return :: a -> Free a Bind :: Free a -> (a -> Free b) -> Free b --- yes, * really does have type *. -type Star = (* :: (* :: (* :: *))) +-- yes, Type really does have type Type. +type Star = (Type :: (Type :: (Type :: Type))) diff --git a/testsuite/tests/dependent/should_compile/RaeJobTalk.hs b/testsuite/tests/dependent/should_compile/RaeJobTalk.hs index 480db090c3..1a22573109 100644 --- a/testsuite/tests/dependent/should_compile/RaeJobTalk.hs +++ b/testsuite/tests/dependent/should_compile/RaeJobTalk.hs @@ -3,7 +3,7 @@ {-# LANGUAGE TypeOperators, TypeFamilies, TypeApplications, AllowAmbiguousTypes, ExplicitForAll, ScopedTypeVariables, GADTs, TypeFamilyDependencies, - TypeInType, ConstraintKinds, UndecidableInstances, + DataKinds, PolyKinds , ConstraintKinds, UndecidableInstances, FlexibleInstances, MultiParamTypeClasses, FunctionalDependencies, FlexibleContexts, StandaloneDeriving, InstanceSigs, RankNTypes, UndecidableSuperClasses #-} diff --git a/testsuite/tests/dependent/should_compile/T11405.hs b/testsuite/tests/dependent/should_compile/T11405.hs index cdb713f118..5fdd7baed1 100644 --- a/testsuite/tests/dependent/should_compile/T11405.hs +++ b/testsuite/tests/dependent/should_compile/T11405.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE ImplicitParams, TypeInType, ExplicitForAll #-} +{-# LANGUAGE ImplicitParams, PolyKinds, ExplicitForAll #-} module T11405 where diff --git a/testsuite/tests/dependent/should_compile/T11635.hs b/testsuite/tests/dependent/should_compile/T11635.hs index 1cbdbafb90..61d9978e55 100644 --- a/testsuite/tests/dependent/should_compile/T11635.hs +++ b/testsuite/tests/dependent/should_compile/T11635.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE TypeInType, KindSignatures, ExplicitForAll #-} +{-# LANGUAGE PolyKinds, KindSignatures, ExplicitForAll, RankNTypes #-} module T11635 where diff --git a/testsuite/tests/dependent/should_compile/T11711.hs b/testsuite/tests/dependent/should_compile/T11711.hs index 0cd4dceb42..814b2a4a68 100644 --- a/testsuite/tests/dependent/should_compile/T11711.hs +++ b/testsuite/tests/dependent/should_compile/T11711.hs @@ -5,7 +5,6 @@ {-# LANGUAGE KindSignatures #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE ViewPatterns #-} -{-# LANGUAGE TypeInType #-} {-# LANGUAGE TypeSynonymInstances #-} {-# LANGUAGE FlexibleInstances #-} diff --git a/testsuite/tests/dependent/should_compile/T11719.hs b/testsuite/tests/dependent/should_compile/T11719.hs index ba4d7c9db4..e4c2a89bf2 100644 --- a/testsuite/tests/dependent/should_compile/T11719.hs +++ b/testsuite/tests/dependent/should_compile/T11719.hs @@ -1,12 +1,12 @@ -{-# LANGUAGE RankNTypes, TypeFamilies, TypeInType, TypeOperators, +{-# LANGUAGE RankNTypes, TypeFamilies, TypeOperators, DataKinds, PolyKinds, UndecidableInstances #-} module T11719 where import Data.Kind -data TyFun :: * -> * -> * -type a ~> b = TyFun a b -> * +data TyFun :: Type -> Type -> Type +type a ~> b = TyFun a b -> Type type family (f :: a ~> b) @@ (x :: a) :: b diff --git a/testsuite/tests/dependent/should_compile/T11966.hs b/testsuite/tests/dependent/should_compile/T11966.hs index 0262a0aed3..daad450f13 100644 --- a/testsuite/tests/dependent/should_compile/T11966.hs +++ b/testsuite/tests/dependent/should_compile/T11966.hs @@ -3,7 +3,6 @@ {-# LANGUAGE KindSignatures #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE RankNTypes #-} -{-# LANGUAGE TypeInType #-} {-# LANGUAGE TypeOperators #-} module T11966 where diff --git a/testsuite/tests/dependent/should_compile/T12176.hs b/testsuite/tests/dependent/should_compile/T12176.hs new file mode 100644 index 0000000000..a11c151567 --- /dev/null +++ b/testsuite/tests/dependent/should_compile/T12176.hs @@ -0,0 +1,18 @@ +{-# LANGUAGE RankNTypes, DataKinds, PolyKinds, GADTs, TypeFamilies #-} + +module T12176 where + +import Data.Kind + +data Proxy :: forall k. k -> Type where + MkProxy :: forall k (a :: k). Proxy a + +data X where + MkX :: forall (k :: Type) (a :: k). Proxy a -> X + +type Expr = (MkX :: forall (a :: Bool). Proxy a -> X) + +type family Foo (x :: forall (a :: k). Proxy a -> X) where + Foo (MkX :: forall (a :: k). Proxy a -> X) = (MkProxy :: Proxy k) + +type Bug = Foo Expr -- this failed with #12176 diff --git a/testsuite/tests/dependent/should_compile/T12442.hs b/testsuite/tests/dependent/should_compile/T12442.hs index f9dbf0a486..c76dfb962e 100644 --- a/testsuite/tests/dependent/should_compile/T12442.hs +++ b/testsuite/tests/dependent/should_compile/T12442.hs @@ -1,7 +1,7 @@ -- Based on https://github.com/idris-lang/Idris-dev/blob/v0.9.10/libs/effects/Effects.idr -{-# LANGUAGE TypeInType, ScopedTypeVariables, TypeOperators, TypeApplications, - GADTs, TypeFamilies, AllowAmbiguousTypes #-} +{-# LANGUAGE DataKinds, PolyKinds, ScopedTypeVariables, TypeOperators, + TypeApplications, GADTs, TypeFamilies, AllowAmbiguousTypes #-} module T12442 where diff --git a/testsuite/tests/dependent/should_compile/T12742.hs b/testsuite/tests/dependent/should_compile/T12742.hs new file mode 100644 index 0000000000..988d7c318a --- /dev/null +++ b/testsuite/tests/dependent/should_compile/T12742.hs @@ -0,0 +1,11 @@ +{-# LANGUAGE DataKinds, PolyKinds, RankNTypes, TypeFamilies #-} + +module T12742 where + +import Data.Kind + +type family F :: forall k2. (k1, k2) + +data T :: (forall k2. (Bool, k2)) -> Type + +type S = T F diff --git a/testsuite/tests/dependent/should_compile/T13910.hs b/testsuite/tests/dependent/should_compile/T13910.hs new file mode 100644 index 0000000000..b3707dd365 --- /dev/null +++ b/testsuite/tests/dependent/should_compile/T13910.hs @@ -0,0 +1,148 @@ +{-# LANGUAGE AllowAmbiguousTypes #-} +{-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE Trustworthy #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeFamilyDependencies #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE TypeOperators #-} +module T13910 where + +import Data.Kind +import Data.Type.Equality + +data family Sing (a :: k) + +class SingKind k where + type Demote k = (r :: Type) | r -> k + fromSing :: Sing (a :: k) -> Demote k + toSing :: Demote k -> SomeSing k + +data SomeSing k where + SomeSing :: Sing (a :: k) -> SomeSing k + +withSomeSing :: forall k r + . SingKind k + => Demote k + -> (forall (a :: k). Sing a -> r) + -> r +withSomeSing x f = + case toSing x of + SomeSing x' -> f x' + +data TyFun :: Type -> Type -> Type +type a ~> b = TyFun a b -> Type +infixr 0 ~> + +type family Apply (f :: k1 ~> k2) (x :: k1) :: k2 +type a @@ b = Apply a b +infixl 9 @@ + +data FunArrow = (:->) | (:~>) + +class FunType (arr :: FunArrow) where + type Fun (k1 :: Type) arr (k2 :: Type) :: Type + +class FunType arr => AppType (arr :: FunArrow) where + type App k1 arr k2 (f :: Fun k1 arr k2) (x :: k1) :: k2 + +type FunApp arr = (FunType arr, AppType arr) + +instance FunType (:->) where + type Fun k1 (:->) k2 = k1 -> k2 + +$(return []) -- This is only necessary for GHC 8.0 -- GHC 8.2 is smarter + +instance AppType (:->) where + type App k1 (:->) k2 (f :: k1 -> k2) x = f x + +instance FunType (:~>) where + type Fun k1 (:~>) k2 = k1 ~> k2 + +$(return []) + +instance AppType (:~>) where + type App k1 (:~>) k2 (f :: k1 ~> k2) x = f @@ x + +infixr 0 -?> +type (-?>) (k1 :: Type) (k2 :: Type) (arr :: FunArrow) = Fun k1 arr k2 + +data instance Sing (z :: a :~: b) where + SRefl :: Sing Refl + +instance SingKind (a :~: b) where + type Demote (a :~: b) = a :~: b + fromSing SRefl = Refl + toSing Refl = SomeSing SRefl + +(~>:~:) :: forall (k :: Type) (a :: k) (b :: k) (r :: a :~: b) (p :: forall (y :: k). a :~: y ~> Type). + Sing r + -> p @@ Refl + -> p @@ r +(~>:~:) SRefl pRefl = pRefl + +type WhyReplacePoly (arr :: FunArrow) (from :: t) (p :: (t -?> Type) arr) + (y :: t) (e :: from :~: y) = App t arr Type p y +data WhyReplacePolySym (arr :: FunArrow) (from :: t) (p :: (t -?> Type) arr) + :: forall (y :: t). from :~: y ~> Type +type instance Apply (WhyReplacePolySym arr from p :: from :~: y ~> Type) x + = WhyReplacePoly arr from p y x + +replace :: forall (t :: Type) (from :: t) (to :: t) (p :: t -> Type). + p from + -> from :~: to + -> p to +replace = replacePoly @(:->) + +replaceTyFun :: forall (t :: Type) (from :: t) (to :: t) (p :: t ~> Type). + p @@ from + -> from :~: to + -> p @@ to +replaceTyFun = replacePoly @(:~>) @_ @_ @_ @p + +replacePoly :: forall (arr :: FunArrow) (t :: Type) (from :: t) (to :: t) + (p :: (t -?> Type) arr). + FunApp arr + => App t arr Type p from + -> from :~: to + -> App t arr Type p to +replacePoly from eq = + withSomeSing eq $ \(singEq :: Sing r) -> + (~>:~:) @t @from @to @r @(WhyReplacePolySym arr from p) singEq from + +type WhyLeibnizPoly (arr :: FunArrow) (f :: (t -?> Type) arr) (a :: t) (z :: t) + = App t arr Type f a -> App t arr Type f z +data WhyLeibnizPolySym (arr :: FunArrow) (f :: (t -?> Type) arr) (a :: t) + :: t ~> Type +type instance Apply (WhyLeibnizPolySym arr f a) z = WhyLeibnizPoly arr f a z + +leibnizPoly :: forall (arr :: FunArrow) (t :: Type) (f :: (t -?> Type) arr) + (a :: t) (b :: t). + FunApp arr + => a :~: b + -> App t arr Type f a + -> App t arr Type f b +leibnizPoly = replaceTyFun @t @a @b @(WhyLeibnizPolySym arr f a) id + +leibniz :: forall (t :: Type) (f :: t -> Type) (a :: t) (b :: t). + a :~: b + -> f a + -> f b +leibniz = replaceTyFun @t @a @b @(WhyLeibnizPolySym (:->) f a) id +-- The line above is what you get if you inline the definition of leibnizPoly. +-- It causes a panic, however. +-- +-- An equivalent implementation is commented out below, which does *not* +-- cause GHC to panic. +-- +-- leibniz = leibnizPoly @(:->) + +leibnizTyFun :: forall (t :: Type) (f :: t ~> Type) (a :: t) (b :: t). + a :~: b + -> f @@ a + -> f @@ b +leibnizTyFun = leibnizPoly @(:~>) @_ @f diff --git a/testsuite/tests/dependent/should_compile/T13938.hs b/testsuite/tests/dependent/should_compile/T13938.hs new file mode 100644 index 0000000000..1ce77d194f --- /dev/null +++ b/testsuite/tests/dependent/should_compile/T13938.hs @@ -0,0 +1,29 @@ +{-# LANGUAGE AllowAmbiguousTypes #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE UndecidableInstances #-} +module T13938 where + +import T13938a +import Data.Kind +import Data.Type.Equality +import GHC.TypeLits + +type family Length (l :: [a]) :: Nat where {} +type family Map (f :: a ~> b) (l :: [a]) :: [b] where {} + +type WhyMapPreservesLength (f :: x ~> y) (l :: [x]) + = Length l :~: Length (Map f l) +data WhyMapPreservesLengthSym1 (f :: x ~> y) :: [x] ~> Type +type instance Apply (WhyMapPreservesLengthSym1 f) l = WhyMapPreservesLength f l + +mapPreservesLength :: forall (x :: Type) (y :: Type) (f :: x ~> y) (l :: [x]). + Length l :~: Length (Map f l) +mapPreservesLength + = elimListTyFun @x @(WhyMapPreservesLengthSym1 f) @l undefined undefined undefined diff --git a/testsuite/tests/dependent/should_compile/T13938a.hs b/testsuite/tests/dependent/should_compile/T13938a.hs new file mode 100644 index 0000000000..5197747e87 --- /dev/null +++ b/testsuite/tests/dependent/should_compile/T13938a.hs @@ -0,0 +1,81 @@ +{-# LANGUAGE AllowAmbiguousTypes #-} +{-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE ExistentialQuantification #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE TypeOperators #-} +module T13938a where + +import Data.Kind (Type) + +data family Sing (a :: k) +data instance Sing (z :: [a]) where + SNil :: Sing '[] + SCons :: Sing x -> Sing xs -> Sing (x:xs) + +data TyFun :: Type -> Type -> Type +type a ~> b = TyFun a b -> Type +infixr 0 ~> + +type family Apply (f :: k1 ~> k2) (x :: k1) :: k2 +type a @@ b = Apply a b +infixl 9 @@ + +data FunArrow = (:->) -- ^ '(->)' + | (:~>) -- ^ '(~>)' + +class FunType (arr :: FunArrow) where + type Fun (k1 :: Type) arr (k2 :: Type) :: Type + +class FunType arr => AppType (arr :: FunArrow) where + type App k1 arr k2 (f :: Fun k1 arr k2) (x :: k1) :: k2 + +type FunApp arr = (FunType arr, AppType arr) + +instance FunType (:->) where + type Fun k1 (:->) k2 = k1 -> k2 + +$(return []) -- This is only necessary for GHC 8.0 -- GHC 8.2 is smarter + +instance AppType (:->) where + type App k1 (:->) k2 (f :: k1 -> k2) x = f x + +instance FunType (:~>) where + type Fun k1 (:~>) k2 = k1 ~> k2 + +$(return []) + +instance AppType (:~>) where + type App k1 (:~>) k2 (f :: k1 ~> k2) x = f @@ x + +infixr 0 -?> +type (-?>) (k1 :: Type) (k2 :: Type) (arr :: FunArrow) = Fun k1 arr k2 + +elimList :: forall (a :: Type) (p :: [a] -> Type) (l :: [a]). + Sing l + -> p '[] + -> (forall (x :: a) (xs :: [a]). Sing x -> Sing xs -> p xs -> p (x:xs)) + -> p l +elimList = elimListPoly @(:->) + +elimListTyFun :: forall (a :: Type) (p :: [a] ~> Type) (l :: [a]). + Sing l + -> p @@ '[] + -> (forall (x :: a) (xs :: [a]). Sing x -> Sing xs -> p @@ xs -> p @@ (x:xs)) + -> p @@ l +elimListTyFun = elimListPoly @(:~>) @_ @p + +elimListPoly :: forall (arr :: FunArrow) (a :: Type) (p :: ([a] -?> Type) arr) (l :: [a]). + FunApp arr + => Sing l + -> App [a] arr Type p '[] + -> (forall (x :: a) (xs :: [a]). Sing x -> Sing xs -> App [a] arr Type p xs -> App [a] arr Type p (x:xs)) + -> App [a] arr Type p l +elimListPoly SNil pNil _ = pNil +elimListPoly (SCons x (xs :: Sing xs)) pNil pCons = pCons x xs (elimListPoly @arr @a @p @xs xs pNil pCons) diff --git a/testsuite/tests/dependent/should_compile/T14038.hs b/testsuite/tests/dependent/should_compile/T14038.hs new file mode 100644 index 0000000000..04b24b9f9e --- /dev/null +++ b/testsuite/tests/dependent/should_compile/T14038.hs @@ -0,0 +1,76 @@ +{-# LANGUAGE AllowAmbiguousTypes #-} +{-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE ExistentialQuantification #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE TypeOperators #-} +module T14038 where + +import Data.Kind (Type) + +data family Sing (a :: k) +data instance Sing (z :: [a]) where + SNil :: Sing '[] + SCons :: Sing x -> Sing xs -> Sing (x:xs) + +data TyFun :: Type -> Type -> Type +type a ~> b = TyFun a b -> Type +infixr 0 ~> + +type family Apply (f :: k1 ~> k2) (x :: k1) :: k2 +type a @@ b = Apply a b +infixl 9 @@ + +data FunArrow = (:->) -- ^ '(->)' + | (:~>) -- ^ '(~>)' + +class FunType (arr :: FunArrow) where + type Fun (k1 :: Type) arr (k2 :: Type) :: Type + +class FunType arr => AppType (arr :: FunArrow) where + type App k1 arr k2 (f :: Fun k1 arr k2) (x :: k1) :: k2 + +type FunApp arr = (FunType arr, AppType arr) + +instance FunType (:->) where + type Fun k1 (:->) k2 = k1 -> k2 + +instance AppType (:->) where + type App k1 (:->) k2 (f :: k1 -> k2) x = f x + +instance FunType (:~>) where + type Fun k1 (:~>) k2 = k1 ~> k2 + +instance AppType (:~>) where + type App k1 (:~>) k2 (f :: k1 ~> k2) x = f @@ x + +infixr 0 -?> +type (-?>) (k1 :: Type) (k2 :: Type) (arr :: FunArrow) = Fun k1 arr k2 + +elimList :: forall (a :: Type) (p :: [a] -> Type) (l :: [a]). + Sing l + -> p '[] + -> (forall (x :: a) (xs :: [a]). Sing x -> Sing xs -> p xs -> p (x:xs)) + -> p l +elimList = elimListPoly @(:->) + +elimListTyFun :: forall (a :: Type) (p :: [a] ~> Type) (l :: [a]). + Sing l + -> p @@ '[] + -> (forall (x :: a) (xs :: [a]). Sing x -> Sing xs -> p @@ xs -> p @@ (x:xs)) + -> p @@ l +elimListTyFun = elimListPoly @(:~>) @_ @p + +elimListPoly :: forall (arr :: FunArrow) (a :: Type) (p :: ([a] -?> Type) arr) (l :: [a]). + FunApp arr + => Sing l + -> App [a] arr Type p '[] + -> (forall (x :: a) (xs :: [a]). Sing x -> Sing xs -> App [a] arr Type p xs -> App [a] arr Type p (x:xs)) + -> App [a] arr Type p l +elimListPoly SNil pNil _ = pNil +elimListPoly (SCons x (xs :: Sing xs)) pNil pCons = pCons x xs (elimListPoly @arr @a @p @xs xs pNil pCons) diff --git a/testsuite/tests/dependent/should_compile/T14066a.hs b/testsuite/tests/dependent/should_compile/T14066a.hs new file mode 100644 index 0000000000..1d6b72491e --- /dev/null +++ b/testsuite/tests/dependent/should_compile/T14066a.hs @@ -0,0 +1,82 @@ +{-# LANGUAGE TypeFamilies, DataKinds, PolyKinds, ExplicitForAll, GADTs, + UndecidableInstances, RankNTypes, ScopedTypeVariables #-} + +module T14066a where + +import Data.Proxy +import Data.Kind +import Data.Type.Bool + + +type family Bar x y where + Bar (x :: a) (y :: b) = Int + Bar (x :: c) (y :: d) = Bool -- a,b,c,d should be TyVarTvs and unify appropriately + + + -- the two k's, even though they have different scopes, should unify in the + -- kind-check and then work in the type-check because Prox3 has been generalized + +data Prox3 a where + MkProx3a :: Prox3 (a :: k1) + MkProx3b :: Prox3 (a :: k2) + + -- This probably should be rejected, as it's polymorphic recursion without a CUSK. + -- But GHC accepts it because the polymorphic occurrence is at a type variable. +data T0 a = forall k (b :: k). MkT0 (T0 b) Int + + -- k and j should unify +type family G x a where + G Int (b :: k) = Int + G Bool (c :: j) = Bool + +-- this last example just checks that GADT pattern-matching on kinds still works. +-- nothing new here. +data T (a :: k) where + MkT :: T (a :: Type -> Type) + +data S (a :: Type -> Type) where + MkS :: S a + +f :: forall k (a :: k). Proxy a -> T a -> () +f _ MkT = let y :: S a + y = MkS + in () + +-- This is questionable. Should we use the RHS to determine dependency? It works +-- now, but if it stops working in the future, that's not a deal-breaker. +type P k a = Proxy (a :: k) + + +-- This is a challenge. It should be accepted, but only because c's kind is learned +-- to be Proxy True, allowing b to be assigned kind `a`. If we don't know c's kind, +-- then GHC would need to be convinced that If (c's kind) b d always has kind `a`. +-- Naively, we don't know about c's kind early enough. + +data SameKind :: forall k. k -> k -> Type +type family IfK (e :: Proxy (j :: Bool)) (f :: m) (g :: n) :: If j m n where + IfK (_ :: Proxy True) f _ = f + IfK (_ :: Proxy False) _ g = g +x :: forall c. (forall a b (d :: a). SameKind (IfK c b d) d) -> (Proxy (c :: Proxy True)) +x _ = Proxy + + +f2 :: forall b. b -> Proxy Maybe +f2 x = fstOf3 y :: Proxy Maybe + where + y :: (Proxy a, Proxy c, b) + y = (Proxy, Proxy, x) + +fstOf3 (x, _, _) = x + +f3 :: forall b. b -> Proxy Maybe +f3 x = fst y :: Proxy Maybe + where + y :: (Proxy a, b) + y = (Proxy, x) + +-- cf. dependent/should_fail/T14066h. Here, y's type does *not* capture any variables, +-- so it is generalized, even with MonoLocalBinds. +f4 x = (fst y :: Proxy Int, fst y :: Proxy Maybe) + where + y :: (Proxy a, Int) + y = (Proxy, x) diff --git a/testsuite/tests/dependent/should_compile/T14066a.stderr b/testsuite/tests/dependent/should_compile/T14066a.stderr new file mode 100644 index 0000000000..610e434d6c --- /dev/null +++ b/testsuite/tests/dependent/should_compile/T14066a.stderr @@ -0,0 +1,5 @@ + +T14066a.hs:13:3: warning: + Type family instance equation is overlapped: + forall d c (x :: c) (y :: d). + Bar x y = Bool -- Defined at T14066a.hs:13:3 diff --git a/testsuite/tests/dependent/should_compile/T14066h.hs b/testsuite/tests/dependent/should_compile/T14066h.hs new file mode 100644 index 0000000000..df3db1c15d --- /dev/null +++ b/testsuite/tests/dependent/should_compile/T14066h.hs @@ -0,0 +1,11 @@ +{-# LANGUAGE ScopedTypeVariables, PolyKinds, MonoLocalBinds #-} + +module T14066h where + +import Data.Proxy + +f :: forall b. b -> (Proxy Int, Proxy Maybe) +f x = (fst y :: Proxy Int, fst y :: Proxy Maybe) + where + y :: (Proxy a, b) -- this generalizes over the kind of a + y = (Proxy, x) diff --git a/testsuite/tests/dependent/should_compile/T14556.hs b/testsuite/tests/dependent/should_compile/T14556.hs new file mode 100644 index 0000000000..133a9e6a44 --- /dev/null +++ b/testsuite/tests/dependent/should_compile/T14556.hs @@ -0,0 +1,39 @@ +{-# Language UndecidableInstances, DataKinds, TypeOperators, PolyKinds, + TypeFamilies, GADTs, LambdaCase, ScopedTypeVariables #-} + +module T14556 where + +import Data.Kind +import Data.Proxy + +data Fn a b where + IdSym :: Fn Type Type + +type family + (@@) (f::Fn k k') (a::k)::k' where + IdSym @@ a = a + +data KIND = X | FNARR KIND KIND + +data TY :: KIND -> Type where + ID :: TY (FNARR X X) + FNAPP :: TY (FNARR k k') -> TY k -> TY k' + +data TyRep (kind::KIND) :: TY kind -> Type where + TID :: TyRep (FNARR X X) ID + TFnApp :: TyRep (FNARR k k') f + -> TyRep k a + -> TyRep k' (FNAPP f a) + +type family + IK (kind::KIND) :: Type where + IK X = Type + IK (FNARR k k') = Fn (IK k) (IK k') + +type family + IT (ty::TY kind) :: IK kind where + IT ID = IdSym + IT (FNAPP f x) = IT f @@ IT x + +zero :: TyRep X a -> IT a +zero = undefined diff --git a/testsuite/tests/dependent/should_compile/T14720.hs b/testsuite/tests/dependent/should_compile/T14720.hs new file mode 100644 index 0000000000..0f053756f5 --- /dev/null +++ b/testsuite/tests/dependent/should_compile/T14720.hs @@ -0,0 +1,45 @@ +{-# LANGUAGE AllowAmbiguousTypes #-} +{-# LANGUAGE DefaultSignatures #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE TypeOperators #-} +module T14720 where + +import Data.Kind (Type) +import Data.Type.Equality ((:~:)(..), sym, trans) +import Data.Void + +data family Sing (z :: k) + +class Generic (a :: Type) where + type Rep a :: Type + from :: a -> Rep a + to :: Rep a -> a + +class PGeneric (a :: Type) where + type PFrom (x :: a) :: Rep a + type PTo (x :: Rep a) :: a + +class SGeneric k where + sFrom :: forall (a :: k). Sing a -> Sing (PFrom a) + sTo :: forall (a :: Rep k). Sing a -> Sing (PTo a :: k) + +class (PGeneric k, SGeneric k) => VGeneric k where + sTof :: forall (a :: k). Sing a -> PTo (PFrom a) :~: a + sFot :: forall (a :: Rep k). Sing a -> PFrom (PTo a :: k) :~: a + +data Decision a = Proved a + | Disproved (a -> Void) + +class SDecide k where + (%~) :: forall (a :: k) (b :: k). Sing a -> Sing b -> Decision (a :~: b) + default (%~) :: forall (a :: k) (b :: k). (VGeneric k, SDecide (Rep k)) + => Sing a -> Sing b -> Decision (a :~: b) + s1 %~ s2 = case sFrom s1 %~ sFrom s2 of + Proved (Refl :: PFrom a :~: PFrom b) -> + case (sTof s1, sTof s2) of + (Refl, Refl) -> Proved Refl + Disproved contra -> Disproved (\Refl -> contra Refl) diff --git a/testsuite/tests/dependent/should_compile/T14749.hs b/testsuite/tests/dependent/should_compile/T14749.hs new file mode 100644 index 0000000000..c4480fad0f --- /dev/null +++ b/testsuite/tests/dependent/should_compile/T14749.hs @@ -0,0 +1,27 @@ +{-# LANGUAGE GADTs, TypeOperators, DataKinds, TypeFamilies, PolyKinds #-} + +module T14749 where + +import Data.Kind + +data KIND = STAR | KIND :> KIND + +data Ty :: KIND -> Type where + TMaybe :: Ty (STAR :> STAR) + TApp :: Ty (a :> b) -> (Ty a -> Ty b) + +type family IK (k :: KIND) = (res :: Type) where + IK STAR = Type + IK (a:>b) = IK a -> IK b + +type family I (t :: Ty k) = (res :: IK k) where + I TMaybe = Maybe + I (TApp f a) = (I f) (I a) + +data TyRep (k :: KIND) (t :: Ty k) where + TyMaybe :: TyRep (STAR:>STAR) TMaybe + TyApp :: TyRep (a:>b) f -> TyRep a x -> TyRep b (TApp f x) + +zero :: TyRep STAR a -> I a +zero x = case x of + TyApp TyMaybe _ -> Nothing diff --git a/testsuite/tests/dependent/should_compile/T14845_compile.hs b/testsuite/tests/dependent/should_compile/T14845_compile.hs new file mode 100644 index 0000000000..04f50189b8 --- /dev/null +++ b/testsuite/tests/dependent/should_compile/T14845_compile.hs @@ -0,0 +1,16 @@ +{-# Language PolyKinds, DataKinds, KindSignatures, GADTs, TypeInType, ConstraintKinds #-} +{-# Language FlexibleContexts #-} +{-# Language RankNTypes #-} +{-# Language TypeOperators #-} +module T14845 where + +import Data.Kind +import Data.Type.Equality + +data A :: Type -> Type where + MkA1 :: a ~ Int => A a + MkA2 :: a ~~ Int => A a + +data SA :: forall a. A a -> Type where + SMkA1 :: SA MkA1 + SMkA2 :: SA MkA2 diff --git a/testsuite/tests/dependent/should_compile/T14991.hs b/testsuite/tests/dependent/should_compile/T14991.hs new file mode 100644 index 0000000000..b2f5642ec5 --- /dev/null +++ b/testsuite/tests/dependent/should_compile/T14991.hs @@ -0,0 +1,35 @@ +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE UndecidableInstances #-} +module T14991 where + +import Data.Kind + +type family Promote (k :: Type) :: Type +type family PromoteX (a :: k) :: Promote k + +type family Demote (k :: Type) :: Type +type family DemoteX (a :: k) :: Demote k + +----- +-- Type +----- + +type instance Demote Type = Type +type instance Promote Type = Type + +type instance DemoteX (a :: Type) = Demote a +type instance PromoteX (a :: Type) = Promote a + +----- +-- Arrows +----- + +data TyFun :: Type -> Type -> Type +type a ~> b = TyFun a b -> Type +infixr 0 ~> + +type instance Demote (a ~> b) = DemoteX a -> DemoteX b +type instance Promote (a -> b) = PromoteX a ~> PromoteX b diff --git a/testsuite/tests/dependent/should_compile/T15264.hs b/testsuite/tests/dependent/should_compile/T15264.hs new file mode 100644 index 0000000000..a03cf4346e --- /dev/null +++ b/testsuite/tests/dependent/should_compile/T15264.hs @@ -0,0 +1,15 @@ +{-# LANGUAGE ExplicitForAll, PolyKinds #-} +{-# OPTIONS -Wcompat #-} + +module T15264 where + +import Data.Proxy + +bad1 :: forall (a :: k). Proxy a -> () +bad1 _ = () + +bad2 :: forall (a :: k1) (b :: k2). Proxy a -> () +bad2 _ = () + +good :: forall k (a :: k). Proxy a -> () +good _ = () diff --git a/testsuite/tests/dependent/should_compile/T15264.stderr b/testsuite/tests/dependent/should_compile/T15264.stderr new file mode 100644 index 0000000000..222d686513 --- /dev/null +++ b/testsuite/tests/dependent/should_compile/T15264.stderr @@ -0,0 +1,10 @@ + +T15264.hs:8:22: warning: [-Wimplicit-kind-vars (in -Wcompat)] + An explicit ‘forall’ was used, but the following kind variables are not quantified: ‘k’ + Despite this fact, GHC will introduce them into scope, but it will stop doing so in the future. + Suggested fix: add ‘forall k.’ + +T15264.hs:11:22: warning: [-Wimplicit-kind-vars (in -Wcompat)] + An explicit ‘forall’ was used, but the following kind variables are not quantified: ‘k1’, ‘k2’ + Despite this fact, GHC will introduce them into scope, but it will stop doing so in the future. + Suggested fix: add ‘forall k1 k2.’ diff --git a/testsuite/tests/dependent/should_compile/T15346.hs b/testsuite/tests/dependent/should_compile/T15346.hs new file mode 100644 index 0000000000..3d8d49b9d2 --- /dev/null +++ b/testsuite/tests/dependent/should_compile/T15346.hs @@ -0,0 +1,31 @@ +{-# LANGUAGE AllowAmbiguousTypes #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeInType #-} +{-# LANGUAGE TypeApplications #-} +module T15346 where + +import Data.Kind +import Data.Proxy + +----- + +type family Rep (a :: Type) :: Type +type instance Rep () = () + +type family PFrom (x :: a) :: Rep a + +----- + +class SDecide k where + test :: forall (a :: k). Proxy a + +instance SDecide () where + test = undefined + +test1 :: forall (a :: k). SDecide (Rep k) => Proxy a +test1 = seq (test @_ @(PFrom a)) Proxy + +test2 :: forall (a :: ()). Proxy a +test2 = test1 diff --git a/testsuite/tests/dependent/should_compile/T15419.hs b/testsuite/tests/dependent/should_compile/T15419.hs new file mode 100644 index 0000000000..68f20e5604 --- /dev/null +++ b/testsuite/tests/dependent/should_compile/T15419.hs @@ -0,0 +1,55 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeInType #-} +{-# LANGUAGE UndecidableInstances #-} +module T15419 where + +import Data.Kind + +data Prod a b +data Proxy p = Proxy + +----- + +data family Sing :: forall k. k -> Type +data instance Sing x = STuple + +----- + +type family Rep1 (f :: k -> Type) :: k -> Type +type instance Rep1 ((,) a) = Prod a + +type family From1 (f :: Type -> Type) a (z :: f a) :: Rep1 f a +type family To1 (f :: Type -> Type) a (z :: Rep1 f a) :: f a + +class Generic1 (f :: Type -> Type) where + sFrom1 :: forall (a :: Type) (z :: f a). Proxy z -> Sing (From1 f a z) + sTo1 :: forall (a :: Type) (r :: Rep1 f a). Proxy r -> Proxy (To1 f a r :: f a) + +instance Generic1 ((,) a) where + sFrom1 Proxy = undefined + sTo1 Proxy = undefined + +----- + +type family Fmap (g :: b) (x :: f a) :: f b +type instance Fmap (g :: b) (x :: (u, a)) = To1 ((,) u) b (Fmap g (From1 ((,) u) a x)) + +class PFunctor (f :: Type -> Type) where + sFmap :: forall a b (g :: b) (x :: f a). + Proxy g -> Sing x -> Proxy (Fmap g x) + +instance PFunctor (Prod a) where + sFmap _ STuple = undefined + +sFmap1 :: forall (f :: Type -> Type) (u :: Type) (b :: Type) (g :: b) (x :: f u). + (Generic1 f, + PFunctor (Rep1 f), + Fmap g x ~ To1 f b (Fmap g (From1 f u x)) ) + => Proxy g -> Proxy x -> Proxy (Fmap g x) +sFmap1 sg sx = sTo1 (sFmap sg (sFrom1 sx)) + +sFmap2 :: forall (p :: Type) (a :: Type) (b :: Type) (g :: b) (x :: (p, a)). + Proxy g -> Proxy x -> Proxy (Fmap g x) +sFmap2 = sFmap1 diff --git a/testsuite/tests/dependent/should_compile/T9632.hs b/testsuite/tests/dependent/should_compile/T9632.hs index bea468fff3..f2099aa22b 100644 --- a/testsuite/tests/dependent/should_compile/T9632.hs +++ b/testsuite/tests/dependent/should_compile/T9632.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE TypeInType #-} +{-# LANGUAGE DataKinds, PolyKinds #-} module T9632 where diff --git a/testsuite/tests/dependent/should_compile/TypeLevelVec.hs b/testsuite/tests/dependent/should_compile/TypeLevelVec.hs index 19f605c8cd..0e2f0c7744 100644 --- a/testsuite/tests/dependent/should_compile/TypeLevelVec.hs +++ b/testsuite/tests/dependent/should_compile/TypeLevelVec.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE TypeInType, UnicodeSyntax, GADTs, NoImplicitPrelude, +{-# LANGUAGE DataKinds, PolyKinds, UnicodeSyntax, GADTs, NoImplicitPrelude, TypeOperators, TypeFamilies #-} {-# OPTIONS_GHC -fno-warn-unticked-promoted-constructors #-} diff --git a/testsuite/tests/dependent/should_compile/all.T b/testsuite/tests/dependent/should_compile/all.T index 8a9b221a4e..418fba2d85 100644 --- a/testsuite/tests/dependent/should_compile/all.T +++ b/testsuite/tests/dependent/should_compile/all.T @@ -10,10 +10,14 @@ test('RaeBlogPost', normal, compile, ['']) test('mkGADTVars', normal, compile, ['']) test('TypeLevelVec',normal,compile, ['']) test('T9632', normal, compile, ['']) -# Simon says in #11330: The "simplifier ticks exhausted" error is expected; -# see Section 7 of the paper: -# http://research.microsoft.com/en-us/um/people/simonpj/papers/haskell-dynamic/ -test('dynamic-paper', expect_fail_for(['optasm', 'optllvm']), compile, ['']) +# The dynamic-paper test fails in the profasm way if we don't increase +# the simplifier tick limit. If we do, we run out of stack +# space. If we increase the stack size enough with -K, +# we run out of simplifier ticks again. This is +# discussed in #11330. +test('dynamic-paper', + expect_broken_for(11330, ['profasm']), + compile_fail, ['']) test('T11311', normal, compile, ['']) test('T11405', normal, compile, ['']) test('T11241', normal, compile, ['']) @@ -24,3 +28,29 @@ test('T11719', normal, compile, ['']) test('T11966', normal, compile, ['']) test('T12442', normal, compile, ['']) test('T13538', normal, compile, ['']) +test('T12176', normal, compile, ['']) +test('T14038', normal, compile, ['']) +test('T12742', normal, compile, ['']) +# we omit profasm because it doesn't bring much to the table but +# introduces its share of complexity, as the test as it is fails with +# profasm: +# T13910.hs:6:5: fatal: +# Cannot load -prof objects when GHC is built with -dynamic +# To fix this, either: +# (1) Use -fexternal-interpreter, or +# (2) Build the program twice: once with -dynamic, and then +# with -prof using -osuf to set a different object file suffix. +test('T13910', omit_ways(['profasm']), compile, ['']) +test('T13938', [extra_files(['T13938a.hs'])], run_command, + ['$MAKE -s --no-print-directory T13938']) +test('T14556', normal, compile, ['']) +test('T14720', normal, compile, ['']) +test('T14066a', normal, compile, ['']) +test('T14749', normal, compile, ['']) +test('T14845_compile', normal, compile, ['']) +test('T14991', normal, compile, ['']) +test('T15264', normal, compile, ['']) +test('DkNameRes', normal, compile, ['']) +test('T15346', normal, compile, ['']) +test('T15419', normal, compile, ['']) +test('T14066h', normal, compile, ['']) diff --git a/testsuite/tests/dependent/should_compile/dynamic-paper.hs b/testsuite/tests/dependent/should_compile/dynamic-paper.hs index 1aa4ee54d9..c998f0967c 100644 --- a/testsuite/tests/dependent/should_compile/dynamic-paper.hs +++ b/testsuite/tests/dependent/should_compile/dynamic-paper.hs @@ -7,7 +7,7 @@ Stephanie Weirich, Richard Eisenberg, and Dimitrios Vytiniotis, 2016. -} {-# LANGUAGE RankNTypes, PolyKinds, TypeOperators, ScopedTypeVariables, GADTs, FlexibleInstances, UndecidableInstances, RebindableSyntax, - DataKinds, MagicHash, AutoDeriveTypeable, TypeInType #-} + DataKinds, MagicHash #-} {-# OPTIONS_GHC -Wno-missing-methods -Wno-redundant-constraints #-} {-# OPTIONS_GHC -Wno-simplifiable-class-constraints #-} -- Because we define a local Typeable class and have @@ -127,7 +127,7 @@ gcast x = do Refl <- eqT (typeRep :: TypeRep a) (typeRep :: TypeRep b) return x -data SameKind :: k -> k -> * +data SameKind :: k -> k -> Type type CheckAppResult = SameKind AppResult AppResultNoKind -- not the most thorough check foo :: AppResult x -> AppResultNoKind x @@ -170,17 +170,20 @@ dynFst :: Dynamic -> Maybe Dynamic dynFst (Dyn (rpab :: TypeRep pab) (x :: pab)) = do App (rpa :: TypeRep pa ) (rb :: TypeRep b) <- splitApp rpab - -- introduces kind |k2|, and types |pa :: k2 -> *|, |b :: k2| + -- introduces kind |k2|, and types |pa :: k2 -> Type|, |b :: k2| App (rp :: TypeRep p ) (ra :: TypeRep a) <- splitApp rpa - -- introduces kind |k1|, and types |p :: k1 -> k2 -> *|, |a :: k1| + -- introduces kind |k1|, and types |p :: k1 -> k2 -> Type|, + -- |a :: k1| Refl <- eqT rp (typeRep :: TypeRep (,)) - -- introduces |p ~ (,)| and |(k1 -> k2 -> *) ~ (* -> * -> *)| + -- introduces |p ~ (,)| and + -- |(k1 -> k2 -> Type) ~ (Type -> Type -> Type)| return (Dyn ra (fst x)) -eqT :: forall k1 k2 (a :: k1) (b :: k2). TypeRep a -> TypeRep b -> Maybe (a :~: b) +eqT :: forall k1 k2 (a :: k1) (b :: k2). + TypeRep a -> TypeRep b -> Maybe (a :~: b) data (a :: k1) :~: (b :: k2) where Refl :: forall k (a :: k). a :~: a @@ -201,11 +204,13 @@ data SomeTypeRep where type TyMapLessTyped = Map SomeTypeRep Dynamic -insertLessTyped :: forall a. Typeable a => a -> TyMapLessTyped -> TyMapLessTyped -insertLessTyped x = Map.insert (SomeTypeRep (typeRep :: TypeRep a)) (toDynamic x) +insertLessTyped :: forall a. Typeable a => a -> TyMapLessTyped -> TyMapLessTyped +insertLessTyped x + = Map.insert (SomeTypeRep (typeRep :: TypeRep a)) (toDynamic x) -lookupLessTyped :: forall a. Typeable a => TyMapLessTyped -> Maybe a -lookupLessTyped = fromDynamic <=< Map.lookup (SomeTypeRep (typeRep :: TypeRep a)) +lookupLessTyped :: forall a. Typeable a => TyMapLessTyped -> Maybe a +lookupLessTyped + = fromDynamic <=< Map.lookup (SomeTypeRep (typeRep :: TypeRep a)) instance Ord SomeTypeRep where compare (SomeTypeRep tr1) (SomeTypeRep tr2) = compareTypeRep tr1 tr2 @@ -329,7 +334,7 @@ dynApplyOld (DynOld trf f) (DynOld trx x) = data DynamicClosed where DynClosed :: TypeRepClosed a -> a -> DynamicClosed -data TypeRepClosed (a :: *) where +data TypeRepClosed (a :: Type) where TBool :: TypeRepClosed Bool TFun :: TypeRepClosed a -> TypeRepClosed b -> TypeRepClosed (a -> b) TProd :: TypeRepClosed a -> TypeRepClosed b -> TypeRepClosed (a, b) diff --git a/testsuite/tests/dependent/should_compile/dynamic-paper.stderr b/testsuite/tests/dependent/should_compile/dynamic-paper.stderr new file mode 100644 index 0000000000..3ba4db2219 --- /dev/null +++ b/testsuite/tests/dependent/should_compile/dynamic-paper.stderr @@ -0,0 +1,15 @@ +Simplifier ticks exhausted + When trying UnfoldingDone delta1 + To increase the limit, use -fsimpl-tick-factor=N (default 100). + + If you need to increase the limit substantially, please file a + bug report and indicate the factor you needed. + + If GHC was unable to complete compilation even with a very large factor + (a thousand or more), please consult the "Known bugs or infelicities" + section in the Users Guide before filing a report. There are a + few situations unlikely to occur in practical programs for which + simplifier non-termination has been judged acceptable. + + To see detailed counts use -ddump-simpl-stats + Total ticks: 140004 diff --git a/testsuite/tests/dependent/should_compile/mkGADTVars.hs b/testsuite/tests/dependent/should_compile/mkGADTVars.hs index 1e74c6980a..9b48e8c395 100644 --- a/testsuite/tests/dependent/should_compile/mkGADTVars.hs +++ b/testsuite/tests/dependent/should_compile/mkGADTVars.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE GADTs, TypeInType #-} +{-# LANGUAGE GADTs, PolyKinds #-} module GADTVars where diff --git a/testsuite/tests/dependent/should_fail/BadTelescope.hs b/testsuite/tests/dependent/should_fail/BadTelescope.hs index acabffec54..11b52f36e2 100644 --- a/testsuite/tests/dependent/should_fail/BadTelescope.hs +++ b/testsuite/tests/dependent/should_fail/BadTelescope.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE TypeInType #-} +{-# LANGUAGE DataKinds, PolyKinds #-} module BadTelescope where diff --git a/testsuite/tests/dependent/should_fail/BadTelescope.stderr b/testsuite/tests/dependent/should_fail/BadTelescope.stderr index 2fbc35a9ba..5fa8efd502 100644 --- a/testsuite/tests/dependent/should_fail/BadTelescope.stderr +++ b/testsuite/tests/dependent/should_fail/BadTelescope.stderr @@ -1,9 +1,6 @@ BadTelescope.hs:9:1: error: - • These kind and type variables: (a :: k) - k - (b :: k) - (c :: SameKind a b) + • These kind and type variables: a k (b :: k) (c :: SameKind a b) are out of dependency order. Perhaps try this ordering: k (a :: k) (b :: k) (c :: SameKind a b) • In the data type declaration for ‘X’ diff --git a/testsuite/tests/dependent/should_fail/BadTelescope2.hs b/testsuite/tests/dependent/should_fail/BadTelescope2.hs index 6237df4488..b12adbd8e3 100644 --- a/testsuite/tests/dependent/should_fail/BadTelescope2.hs +++ b/testsuite/tests/dependent/should_fail/BadTelescope2.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE TypeInType, ExplicitForAll #-} +{-# LANGUAGE DataKinds, PolyKinds, ExplicitForAll #-} module BadTelescope2 where diff --git a/testsuite/tests/dependent/should_fail/BadTelescope2.stderr b/testsuite/tests/dependent/should_fail/BadTelescope2.stderr index 2a9dc76310..55a484910c 100644 --- a/testsuite/tests/dependent/should_fail/BadTelescope2.stderr +++ b/testsuite/tests/dependent/should_fail/BadTelescope2.stderr @@ -3,14 +3,11 @@ BadTelescope2.hs:10:8: error: • These kind and type variables: a k (b :: k) are out of dependency order. Perhaps try this ordering: k (a :: k) (b :: k) - • In the type signature: - foo :: forall a k (b :: k). SameKind a b + • In the type signature: foo :: forall a k (b :: k). SameKind a b -BadTelescope2.hs:13:8: error: - • The kind of variable ‘b’, namely ‘Proxy a’, - depends on variable ‘a’ from an inner scope - Perhaps bind ‘b’ sometime after binding ‘a’ - NB: Implicitly-bound variables always come before other ones. - • In the type signature: +BadTelescope2.hs:13:70: error: + • Expected kind ‘k0’, but ‘d’ has kind ‘Proxy a’ + • In the second argument of ‘SameKind’, namely ‘d’ + In the type signature: bar :: forall a (c :: Proxy b) (d :: Proxy a). Proxy c -> SameKind b d diff --git a/testsuite/tests/dependent/should_fail/BadTelescope3.hs b/testsuite/tests/dependent/should_fail/BadTelescope3.hs index 807479f634..470f5fb9fe 100644 --- a/testsuite/tests/dependent/should_fail/BadTelescope3.hs +++ b/testsuite/tests/dependent/should_fail/BadTelescope3.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE TypeInType, ExplicitForAll #-} +{-# LANGUAGE PolyKinds, ExplicitForAll #-} module BadTelescope3 where diff --git a/testsuite/tests/dependent/should_fail/BadTelescope3.stderr b/testsuite/tests/dependent/should_fail/BadTelescope3.stderr index 4ea7458bb2..1137f28c4d 100644 --- a/testsuite/tests/dependent/should_fail/BadTelescope3.stderr +++ b/testsuite/tests/dependent/should_fail/BadTelescope3.stderr @@ -1,6 +1,6 @@ BadTelescope3.hs:9:1: error: - • These kind and type variables: (a :: k) k (b :: k) + • These kind and type variables: a k (b :: k) are out of dependency order. Perhaps try this ordering: k (a :: k) (b :: k) • In the type synonym declaration for ‘S’ diff --git a/testsuite/tests/dependent/should_fail/BadTelescope4.hs b/testsuite/tests/dependent/should_fail/BadTelescope4.hs index 566922a4a0..bdaf674c2f 100644 --- a/testsuite/tests/dependent/should_fail/BadTelescope4.hs +++ b/testsuite/tests/dependent/should_fail/BadTelescope4.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE ExistentialQuantification, TypeInType #-} +{-# LANGUAGE ExistentialQuantification, DataKinds, PolyKinds #-} module BadTelescope4 where import Data.Proxy diff --git a/testsuite/tests/dependent/should_fail/BadTelescope4.stderr b/testsuite/tests/dependent/should_fail/BadTelescope4.stderr index 2394f896ad..f7c281e983 100644 --- a/testsuite/tests/dependent/should_fail/BadTelescope4.stderr +++ b/testsuite/tests/dependent/should_fail/BadTelescope4.stderr @@ -1,6 +1,6 @@ BadTelescope4.hs:9:1: error: - • These kind and type variables: (a :: k) + • These kind and type variables: a (c :: Proxy b) (d :: Proxy a) (x :: SameKind b d) @@ -11,5 +11,5 @@ BadTelescope4.hs:9:1: error: (c :: Proxy b) (d :: Proxy a) (x :: SameKind b d) - NB: Implicitly declared kind variables are put first. + NB: Implicitly declared variables come before others. • In the data type declaration for ‘Bad’ diff --git a/testsuite/tests/dependent/should_fail/DepFail1.hs b/testsuite/tests/dependent/should_fail/DepFail1.hs index 425a8159c4..26e5d46832 100644 --- a/testsuite/tests/dependent/should_fail/DepFail1.hs +++ b/testsuite/tests/dependent/should_fail/DepFail1.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE TypeInType #-} +{-# LANGUAGE PolyKinds #-} module DepFail1 where diff --git a/testsuite/tests/dependent/should_fail/DepFail1.stderr b/testsuite/tests/dependent/should_fail/DepFail1.stderr index 630f010fa3..a8e64d4e0c 100644 --- a/testsuite/tests/dependent/should_fail/DepFail1.stderr +++ b/testsuite/tests/dependent/should_fail/DepFail1.stderr @@ -2,11 +2,25 @@ DepFail1.hs:7:6: error: • Expecting one more argument to ‘Proxy Bool’ Expected a type, but ‘Proxy Bool’ has kind ‘Bool -> *’ - • In the type signature: - z :: Proxy Bool + • In the type signature: z :: Proxy Bool + +DepFail1.hs:8:5: error: + • Couldn't match expected type ‘Proxy Bool’ + with actual type ‘Proxy k0 a1’ + • In the expression: P + In an equation for ‘z’: z = P DepFail1.hs:10:16: error: • Expected kind ‘Int’, but ‘Bool’ has kind ‘*’ • In the second argument of ‘Proxy’, namely ‘Bool’ - In the type signature: - a :: Proxy Int Bool + In the type signature: a :: Proxy Int Bool + +DepFail1.hs:11:5: error: + • Couldn't match kind ‘*’ with ‘Int’ + When matching types + a0 :: Int + Bool :: * + Expected type: Proxy Int Bool + Actual type: Proxy Int a0 + • In the expression: P + In an equation for ‘a’: a = P diff --git a/testsuite/tests/dependent/should_fail/InferDependency.hs b/testsuite/tests/dependent/should_fail/InferDependency.hs index 47957d47d6..c2bec19d44 100644 --- a/testsuite/tests/dependent/should_fail/InferDependency.hs +++ b/testsuite/tests/dependent/should_fail/InferDependency.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE TypeInType #-} +{-# LANGUAGE PolyKinds #-} module InferDependency where diff --git a/testsuite/tests/dependent/should_fail/InferDependency.stderr b/testsuite/tests/dependent/should_fail/InferDependency.stderr index 7fa900a889..cc852ee58c 100644 --- a/testsuite/tests/dependent/should_fail/InferDependency.stderr +++ b/testsuite/tests/dependent/should_fail/InferDependency.stderr @@ -1,8 +1,10 @@ -InferDependency.hs:6:1: error: - • Invalid declaration for ‘Proxy2’; you must explicitly - declare which variables are dependent on which others. - Inferred variable kinds: +InferDependency.hs:6:13: error: + • Type constructor argument ‘k’ is used dependently. + Any dependent arguments must be obviously so, not inferred + by the type-checker. + Inferred argument kinds: k :: * a :: k + Suggestion: use ‘k’ in a kind to make the dependency clearer. • In the data type declaration for ‘Proxy2’ diff --git a/testsuite/tests/dependent/should_fail/KindLevelsB.hs b/testsuite/tests/dependent/should_fail/KindLevelsB.hs deleted file mode 100644 index 80762978b2..0000000000 --- a/testsuite/tests/dependent/should_fail/KindLevelsB.hs +++ /dev/null @@ -1,9 +0,0 @@ -{-# LANGUAGE DataKinds, PolyKinds #-} - -module KindLevels where - -data A -data B :: A -> * -data C :: B a -> * -data D :: C b -> * -data E :: D c -> * diff --git a/testsuite/tests/dependent/should_fail/KindLevelsB.stderr b/testsuite/tests/dependent/should_fail/KindLevelsB.stderr deleted file mode 100644 index 587eb97bfa..0000000000 --- a/testsuite/tests/dependent/should_fail/KindLevelsB.stderr +++ /dev/null @@ -1,5 +0,0 @@ - -KindLevelsB.hs:7:13: error: - • Expected kind ‘A’, but ‘a’ has kind ‘*’ - • In the first argument of ‘B’, namely ‘a’ - In the kind ‘B a -> *’ diff --git a/testsuite/tests/dependent/should_fail/PromotedClass.hs b/testsuite/tests/dependent/should_fail/PromotedClass.hs index 6c3f415e5d..53d581015d 100644 --- a/testsuite/tests/dependent/should_fail/PromotedClass.hs +++ b/testsuite/tests/dependent/should_fail/PromotedClass.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE TypeInType, GADTs #-} +{-# LANGUAGE DataKinds, GADTs #-} module PromotedClass where diff --git a/testsuite/tests/dependent/should_fail/PromotedClass.stderr b/testsuite/tests/dependent/should_fail/PromotedClass.stderr index f0683309bc..4da1a32fca 100644 --- a/testsuite/tests/dependent/should_fail/PromotedClass.stderr +++ b/testsuite/tests/dependent/should_fail/PromotedClass.stderr @@ -1,5 +1,6 @@ PromotedClass.hs:10:15: error: - • Illegal constraint in a type: Show a0 + • Data constructor ‘MkX’ cannot be used here + (it has an unpromotable context ‘Show a’) • In the first argument of ‘Proxy’, namely ‘( 'MkX 'True)’ In the type signature: foo :: Proxy ( 'MkX 'True) diff --git a/testsuite/tests/dependent/should_fail/RAE_T32a.hs b/testsuite/tests/dependent/should_fail/RAE_T32a.hs index 08a4ad78a8..d71b863f02 100644 --- a/testsuite/tests/dependent/should_fail/RAE_T32a.hs +++ b/testsuite/tests/dependent/should_fail/RAE_T32a.hs @@ -1,34 +1,36 @@ {-# LANGUAGE TemplateHaskell, RankNTypes, TypeOperators, DataKinds, - PolyKinds, TypeFamilies, GADTs, TypeInType #-} + PolyKinds, TypeFamilies, GADTs #-} module RAE_T32a where import Data.Kind -data family Sing (k :: *) :: k -> * +data family Sing (k :: Type) :: k -> Type -data TyArr' (a :: *) (b :: *) :: * -type TyArr (a :: *) (b :: *) = TyArr' a b -> * +data TyArr' (a :: Type) (b :: Type) :: Type +type TyArr (a :: Type) (b :: Type) = TyArr' a b -> Type type family (a :: TyArr k1 k2) @@ (b :: k1) :: k2 -data TyPi' (a :: *) (b :: TyArr a *) :: * -type TyPi (a :: *) (b :: TyArr a *) = TyPi' a b -> * +data TyPi' (a :: Type) (b :: TyArr a Type) :: Type +type TyPi (a :: Type) (b :: TyArr a Type) = TyPi' a b -> Type type family (a :: TyPi k1 k2) @@@ (b :: k1) :: k2 @@ b $(return []) -data MkStar (p :: *) (x :: TyArr' p *) -type instance MkStar p @@ x = * +data MkStar (p :: Type) (x :: TyArr' p Type) +type instance MkStar p @@ x = Type $(return []) -data Sigma (p :: *) (r :: TyPi p (MkStar p)) :: * where +data Sigma (p :: Type) (r :: TyPi p (MkStar p)) :: Type where Sigma :: - forall (p :: *) (r :: TyPi p (MkStar p)) (a :: p) (b :: r @@@ a). - Sing * p -> Sing (TyPi p (MkStar p)) r -> Sing p a -> Sing (r @@@ a) b -> Sigma p r + forall (p :: Type) (r :: TyPi p (MkStar p)) (a :: p) (b :: r @@@ a). + Sing Type p -> Sing (TyPi p (MkStar p)) r -> Sing p a -> + Sing (r @@@ a) b -> Sigma p r $(return []) data instance Sing Sigma (Sigma p r) x where SSigma :: - forall (p :: *) (r :: TyPi p (MkStar p)) (a :: p) (b :: r @@@ a) - (sp :: Sing * p) (sr :: Sing (TyPi p (MkStar p)) r) (sa :: Sing p a) (sb :: Sing (r @@@ a) b). + forall (p :: Type) (r :: TyPi p (MkStar p)) (a :: p) (b :: r @@@ a) + (sp :: Sing Type p) (sr :: Sing (TyPi p (MkStar p)) r) + (sa :: Sing p a) (sb :: Sing (r @@@ a) b). Sing (Sing (r @@@ a) b) sb -> Sing (Sigma p r) ('Sigma sp sr sa sb) diff --git a/testsuite/tests/dependent/should_fail/RAE_T32a.stderr b/testsuite/tests/dependent/should_fail/RAE_T32a.stderr index cb94dd2854..41f5d7cd4c 100644 --- a/testsuite/tests/dependent/should_fail/RAE_T32a.stderr +++ b/testsuite/tests/dependent/should_fail/RAE_T32a.stderr @@ -1,19 +1,18 @@ -RAE_T32a.hs:28:1: error: - Too many parameters to Sing: - x is unexpected; - expected only two parameters - In the data instance declaration for ‘Sing’ +RAE_T32a.hs:29:1: error: + • Expected kind ‘k0 -> *’, + but ‘Sing Sigma (Sigma p r)’ has kind ‘*’ + • In the data instance declaration for ‘Sing’ -RAE_T32a.hs:28:20: error: - Expecting two more arguments to ‘Sigma’ - Expected a type, but - ‘Sigma’ has kind - ‘forall p -> TyPi p (MkStar p) -> *’ - In the first argument of ‘Sing’, namely ‘Sigma’ - In the data instance declaration for ‘Sing’ +RAE_T32a.hs:29:20: error: + • Expecting two more arguments to ‘Sigma’ + Expected a type, but + ‘Sigma’ has kind + ‘forall p -> TyPi p (MkStar p) -> *’ + • In the first argument of ‘Sing’, namely ‘Sigma’ + In the data instance declaration for ‘Sing’ -RAE_T32a.hs:28:27: error: - Expected kind ‘Sigma’, but ‘Sigma p r’ has kind ‘*’ - In the second argument of ‘Sing’, namely ‘(Sigma p r)’ - In the data instance declaration for ‘Sing’ +RAE_T32a.hs:29:27: error: + • Expected kind ‘Sigma’, but ‘Sigma p r’ has kind ‘*’ + • In the second argument of ‘Sing’, namely ‘(Sigma p r)’ + In the data instance declaration for ‘Sing’ diff --git a/testsuite/tests/dependent/should_fail/RenamingStar.hs b/testsuite/tests/dependent/should_fail/RenamingStar.hs index 255021c8d9..f9344b0fd9 100644 --- a/testsuite/tests/dependent/should_fail/RenamingStar.hs +++ b/testsuite/tests/dependent/should_fail/RenamingStar.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE TypeInType #-} +{-# LANGUAGE KindSignatures, NoStarIsType #-} module RenamingStar where diff --git a/testsuite/tests/dependent/should_fail/RenamingStar.stderr b/testsuite/tests/dependent/should_fail/RenamingStar.stderr index 5efda699fd..4001811f1f 100644 --- a/testsuite/tests/dependent/should_fail/RenamingStar.stderr +++ b/testsuite/tests/dependent/should_fail/RenamingStar.stderr @@ -1,11 +1,5 @@ RenamingStar.hs:5:13: error: - Not in scope: type constructor or class ‘*’ - NB: With TypeInType, you must import * from Data.Kind - -RenamingStar.hs:5:13: error: - Illegal operator ‘*’ in type ‘*’ - Use TypeOperators to allow operators in types - -RenamingStar.hs:5:13: error: Operator applied to too few arguments: * + With NoStarIsType, ‘*’ is treated as a regular type operator. + Did you mean to use ‘Type’ from Data.Kind instead? diff --git a/testsuite/tests/dependent/should_fail/SelfDep.hs b/testsuite/tests/dependent/should_fail/SelfDep.hs index f54b92752b..22ac9ede98 100644 --- a/testsuite/tests/dependent/should_fail/SelfDep.hs +++ b/testsuite/tests/dependent/should_fail/SelfDep.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE KindSignatures #-} + module SelfDep where data T :: T -> * diff --git a/testsuite/tests/dependent/should_fail/SelfDep.stderr b/testsuite/tests/dependent/should_fail/SelfDep.stderr index f4014f7277..8ac4be8c0c 100644 --- a/testsuite/tests/dependent/should_fail/SelfDep.stderr +++ b/testsuite/tests/dependent/should_fail/SelfDep.stderr @@ -1,5 +1,5 @@ -SelfDep.hs:3:11: error: - Type constructor ‘T’ cannot be used here - (it is defined and used in the same recursive group) - In the kind ‘T -> *’ +SelfDep.hs:5:11: error: + • Type constructor ‘T’ cannot be used here + (it is defined and used in the same recursive group) + • In the kind ‘T -> *’ diff --git a/testsuite/tests/dependent/should_fail/T11407.hs b/testsuite/tests/dependent/should_fail/T11407.hs index 533870f94b..e94eaba1e7 100644 --- a/testsuite/tests/dependent/should_fail/T11407.hs +++ b/testsuite/tests/dependent/should_fail/T11407.hs @@ -1,5 +1,5 @@ {-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE TypeInType #-} +{-# LANGUAGE DataKinds, PolyKinds #-} module T11407 where import Data.Kind diff --git a/testsuite/tests/dependent/should_fail/T11471.hs b/testsuite/tests/dependent/should_fail/T11471.hs index 19025db22b..ae09ae07bb 100644 --- a/testsuite/tests/dependent/should_fail/T11471.hs +++ b/testsuite/tests/dependent/should_fail/T11471.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE MagicHash, PolyKinds, TypeFamilies #-} +{-# LANGUAGE MagicHash, PolyKinds, TypeFamilies, AllowAmbiguousTypes #-} module T11471 where diff --git a/testsuite/tests/dependent/should_fail/T11471.stderr b/testsuite/tests/dependent/should_fail/T11471.stderr index 80c5fc606c..640ae6c754 100644 --- a/testsuite/tests/dependent/should_fail/T11471.stderr +++ b/testsuite/tests/dependent/should_fail/T11471.stderr @@ -1,19 +1,22 @@ T11471.hs:15:10: error: • Couldn't match a lifted type with an unlifted type - Expected type: Proxy Int# + When matching types + a :: * + Int# :: TYPE 'IntRep + Expected type: Proxy a Actual type: Proxy Int# - Use -fprint-explicit-kinds to see the kind arguments • In the first argument of ‘f’, namely ‘(undefined :: Proxy Int#)’ In the expression: f (undefined :: Proxy Int#) 3# In an equation for ‘bad’: bad = f (undefined :: Proxy Int#) 3# + • Relevant bindings include bad :: F a (bound at T11471.hs:15:1) T11471.hs:15:35: error: • Couldn't match a lifted type with an unlifted type When matching types - F Int# :: * + F a :: * Int# :: TYPE 'IntRep • In the second argument of ‘f’, namely ‘3#’ In the expression: f (undefined :: Proxy Int#) 3# In an equation for ‘bad’: bad = f (undefined :: Proxy Int#) 3# - • Relevant bindings include bad :: F Int# (bound at T11471.hs:15:1) + • Relevant bindings include bad :: F a (bound at T11471.hs:15:1) diff --git a/testsuite/tests/dependent/should_fail/T11473.hs b/testsuite/tests/dependent/should_fail/T11473.hs index 12d95caac6..ebfeeb8a13 100644 --- a/testsuite/tests/dependent/should_fail/T11473.hs +++ b/testsuite/tests/dependent/should_fail/T11473.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE PolyKinds, TypeFamilies, MagicHash, DataKinds, TypeInType, RankNTypes #-} +{-# LANGUAGE PolyKinds, TypeFamilies, MagicHash, DataKinds, RankNTypes #-} module T11473 where diff --git a/testsuite/tests/dependent/should_fail/T12081.hs b/testsuite/tests/dependent/should_fail/T12081.hs index f68de420cb..0bf03b1950 100644 --- a/testsuite/tests/dependent/should_fail/T12081.hs +++ b/testsuite/tests/dependent/should_fail/T12081.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE TypeInType #-} +{-# LANGUAGE DataKinds, PolyKinds #-} module T12081 where diff --git a/testsuite/tests/dependent/should_fail/T12174.hs b/testsuite/tests/dependent/should_fail/T12174.hs index 29064d6a96..800759d690 100644 --- a/testsuite/tests/dependent/should_fail/T12174.hs +++ b/testsuite/tests/dependent/should_fail/T12174.hs @@ -1,7 +1,7 @@ {-# LANGUAGE DataKinds #-} +{-# LANGUAGE PolyKinds #-} {-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE KindSignatures #-} -{-# LANGUAGE TypeInType #-} module T12174 where data V a diff --git a/testsuite/tests/dependent/should_fail/T13135.hs b/testsuite/tests/dependent/should_fail/T13135.hs index c39b3f5842..8f78ccbfb1 100644 --- a/testsuite/tests/dependent/should_fail/T13135.hs +++ b/testsuite/tests/dependent/should_fail/T13135.hs @@ -8,11 +8,11 @@ {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE PolyKinds #-} -{-# LANGUAGE TypeInType #-} {-# LANGUAGE TypeFamilyDependencies #-} -module T12135 where + +module T13135 where import Data.Kind (Type) @@ -62,7 +62,7 @@ arrLen = smartSym sym where -{- The original bug was a familure to subsitute +{- The original bug was a failure to substitute properly during type-function improvement. -------------------------------------- diff --git a/testsuite/tests/dependent/should_fail/T13601.hs b/testsuite/tests/dependent/should_fail/T13601.hs new file mode 100644 index 0000000000..a8fa34d4a0 --- /dev/null +++ b/testsuite/tests/dependent/should_fail/T13601.hs @@ -0,0 +1,47 @@ +{-# LANGUAGE TypeFamilies, DataKinds, PolyKinds #-} + +import GHC.Exts +import Prelude (Bool(True,False),Integer,Ordering,undefined) +import qualified Prelude +import Data.Kind + +-------------------- +-- class hierarchy + +type family + Rep (rep :: RuntimeRep) :: RuntimeRep where + -- Rep IntRep = IntRep + -- Rep DoubleRep = IntRep + -- Rep PtrRepUnlifted = IntRep + -- Rep PtrRepLifted = PtrRepLifted + +class Boolean (Logic a) => Eq (a :: TYPE rep) where + type Logic (a :: TYPE rep) :: TYPE (Rep rep) + (==) :: a -> a -> Logic a + +class Eq a => POrd (a :: TYPE rep) where + inf :: a -> a -> a + +class POrd a => MinBound (a :: TYPE rep) where + minBound :: () -> a + +class POrd a => Lattice (a :: TYPE rep) where + sup :: a -> a -> a + +class (Lattice a, MinBound a) => Bounded (a :: TYPE rep) where + maxBound :: () -> a + +class Bounded a => Complemented (a :: TYPE rep) where + not :: a -> a + +class Bounded a => Heyting (a :: TYPE rep) where + infixr 3 ==> + (==>) :: a -> a -> a + +class (Complemented a, Heyting a) => Boolean a + +(||) :: Boolean a => a -> a -> a +(||) = sup + +(&&) :: Boolean a => a -> a -> a +(&&) = inf diff --git a/testsuite/tests/dependent/should_fail/T13601.stderr b/testsuite/tests/dependent/should_fail/T13601.stderr new file mode 100644 index 0000000000..bc2877c3e6 --- /dev/null +++ b/testsuite/tests/dependent/should_fail/T13601.stderr @@ -0,0 +1,5 @@ + +T13601.hs:18:16: error: + • Expected a type, but ‘Logic a’ has kind ‘TYPE (Rep rep)’ + • In the first argument of ‘Boolean’, namely ‘(Logic a)’ + In the class declaration for ‘Eq’ diff --git a/testsuite/tests/dependent/should_fail/T13780a.hs b/testsuite/tests/dependent/should_fail/T13780a.hs new file mode 100644 index 0000000000..b7e1510672 --- /dev/null +++ b/testsuite/tests/dependent/should_fail/T13780a.hs @@ -0,0 +1,9 @@ +{-# LANGUAGE ExistentialQuantification #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE DataKinds, PolyKinds #-} +module T13780a where + +data family Sing (a :: k) + +data Foo a = a ~ Bool => MkFoo +data instance Sing (z :: Foo a) = (z ~ MkFoo) => SMkFoo diff --git a/testsuite/tests/dependent/should_fail/T13780a.stderr b/testsuite/tests/dependent/should_fail/T13780a.stderr new file mode 100644 index 0000000000..3b113bd89e --- /dev/null +++ b/testsuite/tests/dependent/should_fail/T13780a.stderr @@ -0,0 +1,6 @@ + +T13780a.hs:9:40: error: + • Expected kind ‘Foo a’, but ‘MkFoo’ has kind ‘Foo Bool’ + • In the second argument of ‘(~)’, namely ‘MkFoo’ + In the definition of data constructor ‘SMkFoo’ + In the data instance declaration for ‘Sing’ diff --git a/testsuite/tests/dependent/should_fail/T13780b.hs b/testsuite/tests/dependent/should_fail/T13780b.hs new file mode 100644 index 0000000000..dc6ac89c08 --- /dev/null +++ b/testsuite/tests/dependent/should_fail/T13780b.hs @@ -0,0 +1,11 @@ +{-# LANGUAGE GADTs #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE PolyKinds #-} +module T13780b where + +data family Sing (a :: k) + +data instance Sing (z :: Bool) = + z ~ False => SFalse + | z ~ True => STrue diff --git a/testsuite/tests/dependent/should_fail/T13780c.hs b/testsuite/tests/dependent/should_fail/T13780c.hs new file mode 100644 index 0000000000..78e09f5ef1 --- /dev/null +++ b/testsuite/tests/dependent/should_fail/T13780c.hs @@ -0,0 +1,12 @@ +{-# LANGUAGE GADTs #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE DataKinds, PolyKinds #-} +module T13780c where + +import Data.Kind +import T13780b + +type family ElimBool (p :: Bool -> Type) (b :: Bool) (s :: Sing b) + (pFalse :: p False) (pTrue :: p True) :: p b where + ElimBool _ _ SFalse pFalse _ = pFalse + ElimBool _ _ STrue _ pTrue = pTrue diff --git a/testsuite/tests/dependent/should_fail/T13780c.stderr b/testsuite/tests/dependent/should_fail/T13780c.stderr new file mode 100644 index 0000000000..9a196f4bd7 --- /dev/null +++ b/testsuite/tests/dependent/should_fail/T13780c.stderr @@ -0,0 +1,14 @@ +[1 of 2] Compiling T13780b ( T13780b.hs, T13780b.o ) +[2 of 2] Compiling T13780c ( T13780c.hs, T13780c.o ) + +T13780c.hs:11:16: error: + • Data constructor ‘SFalse’ cannot be used here + (it comes from a data family instance) + • In the third argument of ‘ElimBool’, namely ‘SFalse’ + In the type family declaration for ‘ElimBool’ + +T13780c.hs:12:16: error: + • Data constructor ‘STrue’ cannot be used here + (it comes from a data family instance) + • In the third argument of ‘ElimBool’, namely ‘STrue’ + In the type family declaration for ‘ElimBool’ diff --git a/testsuite/tests/dependent/should_fail/T13895.hs b/testsuite/tests/dependent/should_fail/T13895.hs new file mode 100644 index 0000000000..5897cd8149 --- /dev/null +++ b/testsuite/tests/dependent/should_fail/T13895.hs @@ -0,0 +1,15 @@ +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE TypeInType #-} +module T13895 where + +import Data.Data (Data, Typeable) +import Data.Kind + +dataCast1 :: forall (a :: Type). + Data a + => forall (c :: Type -> Type) + (t :: forall (k :: Type). Typeable k => k -> Type). + Typeable t + => (forall d. Data d => c (t d)) + -> Maybe (c a) +dataCast1 _ = undefined diff --git a/testsuite/tests/dependent/should_fail/T13895.stderr b/testsuite/tests/dependent/should_fail/T13895.stderr new file mode 100644 index 0000000000..3e8bef6858 --- /dev/null +++ b/testsuite/tests/dependent/should_fail/T13895.stderr @@ -0,0 +1,44 @@ + +T13895.hs:8:14: error: + • Could not deduce (Typeable (t dict0)) + from the context: (Data a, Typeable (t dict)) + bound by the type signature for: + dataCast1 :: forall k (dict :: Typeable k) (dict1 :: Typeable + *) a (c :: * + -> *) (t :: forall k1. + Typeable + k1 => + k1 + -> *). + (Data a, Typeable (t dict)) => + (forall d. Data d => c (t dict1 d)) -> Maybe (c a) + at T13895.hs:(8,14)-(14,24) + The type variable ‘dict0’ is ambiguous + • In the ambiguity check for ‘dataCast1’ + To defer the ambiguity check to use sites, enable AllowAmbiguousTypes + In the type signature: + dataCast1 :: forall (a :: Type). + Data a => + forall (c :: Type -> Type) + (t :: forall (k :: Type). Typeable k => k -> Type). + Typeable t => (forall d. Data d => c (t d)) -> Maybe (c a) + +T13895.hs:12:23: error: + • Illegal constraint in a kind: Typeable k0 + • In the first argument of ‘Typeable’, namely ‘t’ + In the type signature: + dataCast1 :: forall (a :: Type). + Data a => + forall (c :: Type -> Type) + (t :: forall (k :: Type). Typeable k => k -> Type). + Typeable t => (forall d. Data d => c (t d)) -> Maybe (c a) + +T13895.hs:13:38: error: + • Illegal constraint in a kind: Typeable k0 + • In the first argument of ‘c’, namely ‘(t d)’ + In the type signature: + dataCast1 :: forall (a :: Type). + Data a => + forall (c :: Type -> Type) + (t :: forall (k :: Type). Typeable k => k -> Type). + Typeable t => (forall d. Data d => c (t d)) -> Maybe (c a) diff --git a/testsuite/tests/dependent/should_fail/T14066.hs b/testsuite/tests/dependent/should_fail/T14066.hs new file mode 100644 index 0000000000..709d507a34 --- /dev/null +++ b/testsuite/tests/dependent/should_fail/T14066.hs @@ -0,0 +1,17 @@ +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE PolyKinds #-} + + + +module T14066 where + +import Data.Kind ( Type ) +import Data.Type.Equality +import Data.Proxy +import GHC.Exts + +data SameKind :: k -> k -> Type + +f (x :: Proxy a) = let g :: forall k (b :: k). SameKind a b + g = undefined + in () diff --git a/testsuite/tests/dependent/should_fail/T14066.stderr b/testsuite/tests/dependent/should_fail/T14066.stderr new file mode 100644 index 0000000000..e5179e510b --- /dev/null +++ b/testsuite/tests/dependent/should_fail/T14066.stderr @@ -0,0 +1,13 @@ + +T14066.hs:15:59: error: + • Expected kind ‘k’, but ‘b’ has kind ‘k1’ + • In the second argument of ‘SameKind’, namely ‘b’ + In the type signature: g :: forall k (b :: k). SameKind a b + In the expression: + let + g :: forall k (b :: k). SameKind a b + g = undefined + in () + • Relevant bindings include + x :: Proxy a (bound at T14066.hs:15:4) + f :: Proxy a -> () (bound at T14066.hs:15:1) diff --git a/testsuite/tests/dependent/should_fail/T14066c.hs b/testsuite/tests/dependent/should_fail/T14066c.hs new file mode 100644 index 0000000000..4dd6f41973 --- /dev/null +++ b/testsuite/tests/dependent/should_fail/T14066c.hs @@ -0,0 +1,9 @@ +{-# LANGUAGE TypeFamilies, DataKinds, PolyKinds, UndecidableInstances #-} + +module T14066c where + +type family H a b where + H a b = H b a + +type X = H True Nothing -- this should fail to kind-check. + -- if it's accepted, then we've inferred polymorphic recursion for H diff --git a/testsuite/tests/dependent/should_fail/T14066c.stderr b/testsuite/tests/dependent/should_fail/T14066c.stderr new file mode 100644 index 0000000000..dc5ba30a4f --- /dev/null +++ b/testsuite/tests/dependent/should_fail/T14066c.stderr @@ -0,0 +1,6 @@ + +T14066c.hs:8:17: error: + • Expected kind ‘Bool’, but ‘Nothing’ has kind ‘Maybe a0’ + • In the second argument of ‘H’, namely ‘Nothing’ + In the type ‘H True Nothing’ + In the type declaration for ‘X’ diff --git a/testsuite/tests/dependent/should_fail/T14066d.hs b/testsuite/tests/dependent/should_fail/T14066d.hs new file mode 100644 index 0000000000..dd5676826d --- /dev/null +++ b/testsuite/tests/dependent/should_fail/T14066d.hs @@ -0,0 +1,17 @@ +{-# LANGUAGE RankNTypes, ScopedTypeVariables, PolyKinds #-} + +module T14066d where + +import Data.Proxy + +g :: (forall c b (a :: c). (Proxy a, Proxy c, b)) -> () +g _ = () + +f :: forall b. b -> (Proxy Maybe, ()) +f x = (fstOf3 y :: Proxy Maybe, g y) + where + y :: (Proxy a, Proxy c, b) -- this should NOT generalize over b + -- meaning the call to g is ill-typed + y = (Proxy, Proxy, x) + +fstOf3 (x, _, _) = x diff --git a/testsuite/tests/dependent/should_fail/T14066d.stderr b/testsuite/tests/dependent/should_fail/T14066d.stderr new file mode 100644 index 0000000000..8ece51029b --- /dev/null +++ b/testsuite/tests/dependent/should_fail/T14066d.stderr @@ -0,0 +1,21 @@ + +T14066d.hs:11:35: error: + • Couldn't match type ‘b1’ with ‘b’ + ‘b1’ is a rigid type variable bound by + a type expected by the context: + forall c b1 (a :: c). (Proxy a, Proxy c, b1) + at T14066d.hs:11:35 + ‘b’ is a rigid type variable bound by + the type signature for: + f :: forall b. b -> (Proxy Maybe, ()) + at T14066d.hs:10:1-37 + Expected type: (Proxy a, Proxy c, b1) + Actual type: (Proxy a, Proxy c, b) + • In the first argument of ‘g’, namely ‘y’ + In the expression: g y + In the expression: (fstOf3 y :: Proxy Maybe, g y) + • Relevant bindings include + y :: forall k1 k2 (a :: k2) (c :: k1). (Proxy a, Proxy c, b) + (bound at T14066d.hs:15:5) + x :: b (bound at T14066d.hs:11:3) + f :: b -> (Proxy Maybe, ()) (bound at T14066d.hs:11:1) diff --git a/testsuite/tests/dependent/should_fail/T14066e.hs b/testsuite/tests/dependent/should_fail/T14066e.hs new file mode 100644 index 0000000000..9bce332527 --- /dev/null +++ b/testsuite/tests/dependent/should_fail/T14066e.hs @@ -0,0 +1,13 @@ +{-# LANGUAGE MonoLocalBinds, PolyKinds, ScopedTypeVariables #-} + +module T14066e where + +import Data.Proxy + +-- this should fail because the dependency between b and c can't be +-- determined in the type signature +h :: forall a. a -> () +h x = () + where + j :: forall c b. Proxy a -> Proxy b -> Proxy c -> Proxy b + j _ (p1 :: Proxy b') (p2 :: Proxy c') = (p1 :: Proxy (b' :: c')) diff --git a/testsuite/tests/dependent/should_fail/T14066e.stderr b/testsuite/tests/dependent/should_fail/T14066e.stderr new file mode 100644 index 0000000000..193c74d193 --- /dev/null +++ b/testsuite/tests/dependent/should_fail/T14066e.stderr @@ -0,0 +1,20 @@ + +T14066e.hs:13:59: error: + • Couldn't match kind ‘k1’ with ‘*’ + ‘k1’ is a rigid type variable bound by + the type signature for: + j :: forall k k1 (c :: k1) (b :: k). + Proxy a -> Proxy b -> Proxy c -> Proxy b + at T14066e.hs:12:5-61 + When matching kinds + k :: * + c :: k1 + Expected kind ‘c’, but ‘b'’ has kind ‘k’ + • In the first argument of ‘Proxy’, namely ‘(b' :: c')’ + In an expression type signature: Proxy (b' :: c') + In the expression: (p1 :: Proxy (b' :: c')) + • Relevant bindings include + p2 :: Proxy c (bound at T14066e.hs:13:27) + p1 :: Proxy b (bound at T14066e.hs:13:10) + j :: Proxy a -> Proxy b -> Proxy c -> Proxy b + (bound at T14066e.hs:13:5) diff --git a/testsuite/tests/dependent/should_fail/T14066f.hs b/testsuite/tests/dependent/should_fail/T14066f.hs new file mode 100644 index 0000000000..b2035f2c3d --- /dev/null +++ b/testsuite/tests/dependent/should_fail/T14066f.hs @@ -0,0 +1,8 @@ +{-# LANGUAGE PolyKinds #-} + +module T14066f where + +import Data.Proxy + +-- a can't come before k. +type P a k = Proxy (a :: k) diff --git a/testsuite/tests/dependent/should_fail/T14066f.stderr b/testsuite/tests/dependent/should_fail/T14066f.stderr new file mode 100644 index 0000000000..44c4ed293c --- /dev/null +++ b/testsuite/tests/dependent/should_fail/T14066f.stderr @@ -0,0 +1,6 @@ + +T14066f.hs:8:1: error: + • These kind and type variables: a k + are out of dependency order. Perhaps try this ordering: + k (a :: k) + • In the type synonym declaration for ‘P’ diff --git a/testsuite/tests/dependent/should_fail/T14066g.hs b/testsuite/tests/dependent/should_fail/T14066g.hs new file mode 100644 index 0000000000..b07a2c36a9 --- /dev/null +++ b/testsuite/tests/dependent/should_fail/T14066g.hs @@ -0,0 +1,9 @@ +{-# LANGUAGE DataKinds, PolyKinds #-} + +module T14066g where + +import Data.Kind + +data SameKind :: k -> k -> Type + +data Q a (b :: a) (d :: SameKind c b) diff --git a/testsuite/tests/dependent/should_fail/T14066g.stderr b/testsuite/tests/dependent/should_fail/T14066g.stderr new file mode 100644 index 0000000000..22ca786343 --- /dev/null +++ b/testsuite/tests/dependent/should_fail/T14066g.stderr @@ -0,0 +1,7 @@ + +T14066g.hs:9:1: error: + • These kind and type variables: a (b :: a) (d :: SameKind c b) + are out of dependency order. Perhaps try this ordering: + a (c :: a) (b :: a) (d :: SameKind c b) + NB: Implicitly declared variables come before others. + • In the data type declaration for ‘Q’ diff --git a/testsuite/tests/dependent/should_fail/T14845_fail1.hs b/testsuite/tests/dependent/should_fail/T14845_fail1.hs new file mode 100644 index 0000000000..46c1351027 --- /dev/null +++ b/testsuite/tests/dependent/should_fail/T14845_fail1.hs @@ -0,0 +1,10 @@ +{-# Language PolyKinds, DataKinds, KindSignatures, GADTs, TypeInType, ConstraintKinds #-} +module T14845_fail1 where + +import Data.Kind + +data Struct :: (k -> Constraint) -> (k -> Type) where + S :: cls a => Struct cls a + +data Foo a where + F :: Foo (S::Struct Eq a) diff --git a/testsuite/tests/dependent/should_fail/T14845_fail1.stderr b/testsuite/tests/dependent/should_fail/T14845_fail1.stderr new file mode 100644 index 0000000000..c1f1c8605d --- /dev/null +++ b/testsuite/tests/dependent/should_fail/T14845_fail1.stderr @@ -0,0 +1,7 @@ + +T14845_fail1.hs:10:13: error: + • Data constructor ‘S’ cannot be used here + (it has an unpromotable context ‘cls a’) + • In the first argument of ‘Foo’, namely ‘(S :: Struct Eq a)’ + In the type ‘Foo (S :: Struct Eq a)’ + In the definition of data constructor ‘F’ diff --git a/testsuite/tests/dependent/should_fail/T14845_fail2.hs b/testsuite/tests/dependent/should_fail/T14845_fail2.hs new file mode 100644 index 0000000000..4c5dac730f --- /dev/null +++ b/testsuite/tests/dependent/should_fail/T14845_fail2.hs @@ -0,0 +1,14 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeInType #-} +module T14845_fail2 where + +import Data.Coerce +import Data.Kind + +data A :: Type -> Type where + MkA :: Coercible a Int => A a + +data SA :: forall a. A a -> Type where + SMkA :: SA MkA diff --git a/testsuite/tests/dependent/should_fail/T14845_fail2.stderr b/testsuite/tests/dependent/should_fail/T14845_fail2.stderr new file mode 100644 index 0000000000..9fe733f374 --- /dev/null +++ b/testsuite/tests/dependent/should_fail/T14845_fail2.stderr @@ -0,0 +1,7 @@ + +T14845_fail2.hs:14:14: error: + • Data constructor ‘MkA’ cannot be used here + (it has an unpromotable context ‘Coercible a Int’) + • In the first argument of ‘SA’, namely ‘MkA’ + In the type ‘SA MkA’ + In the definition of data constructor ‘SMkA’ diff --git a/testsuite/tests/dependent/should_fail/T15215.hs b/testsuite/tests/dependent/should_fail/T15215.hs new file mode 100644 index 0000000000..96fe04385b --- /dev/null +++ b/testsuite/tests/dependent/should_fail/T15215.hs @@ -0,0 +1,12 @@ +{-# LANGUAGE GADTs #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeInType #-} +module T15215 where + +import Data.Kind + +data A :: Type -> Type where + MkA :: Show (Maybe a) => A a + +data SA :: forall a. A a -> Type where + SMkA :: SA MkA diff --git a/testsuite/tests/dependent/should_fail/T15215.stderr b/testsuite/tests/dependent/should_fail/T15215.stderr new file mode 100644 index 0000000000..53aff765a3 --- /dev/null +++ b/testsuite/tests/dependent/should_fail/T15215.stderr @@ -0,0 +1,12 @@ + +T15215.hs:9:3: error: + • Non type-variable argument in the constraint: Show (Maybe a) + (Use FlexibleContexts to permit this) + • In the definition of data constructor ‘MkA’ + In the data type declaration for ‘A’ + +T15215.hs:12:14: error: + • Illegal constraint in a kind: Show (Maybe a0) + • In the first argument of ‘SA’, namely ‘MkA’ + In the type ‘SA MkA’ + In the definition of data constructor ‘SMkA’ diff --git a/testsuite/tests/dependent/should_fail/T15245.hs b/testsuite/tests/dependent/should_fail/T15245.hs new file mode 100644 index 0000000000..86d9c221e0 --- /dev/null +++ b/testsuite/tests/dependent/should_fail/T15245.hs @@ -0,0 +1,10 @@ +{-# LANGUAGE TypeFamilies, DataKinds, PolyKinds, TypeApplications #-} + +module T15245 where + +import Type.Reflection + +data family K +data instance K = MkK + +main = print (typeRep @'MkK) diff --git a/testsuite/tests/dependent/should_fail/T15245.stderr b/testsuite/tests/dependent/should_fail/T15245.stderr new file mode 100644 index 0000000000..b41076636f --- /dev/null +++ b/testsuite/tests/dependent/should_fail/T15245.stderr @@ -0,0 +1,7 @@ + +T15245.hs:10:24: error: + • Data constructor ‘MkK’ cannot be used here + (it comes from a data family instance) + • In the type ‘ 'MkK’ + In the first argument of ‘print’, namely ‘(typeRep @ 'MkK)’ + In the expression: print (typeRep @ 'MkK) diff --git a/testsuite/tests/dependent/should_fail/T15308.hs b/testsuite/tests/dependent/should_fail/T15308.hs new file mode 100644 index 0000000000..b49fe1f75b --- /dev/null +++ b/testsuite/tests/dependent/should_fail/T15308.hs @@ -0,0 +1,12 @@ +{-# LANGUAGE GADTs #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeInType #-} +module T15308 where + +import Data.Kind + +data Foo (a :: Type) :: forall b. (a -> b -> Type) -> Type where + MkFoo :: Foo a f + +f :: Foo a f -> String +f = show diff --git a/testsuite/tests/dependent/should_fail/T15308.stderr b/testsuite/tests/dependent/should_fail/T15308.stderr new file mode 100644 index 0000000000..a4bdbd5ab6 --- /dev/null +++ b/testsuite/tests/dependent/should_fail/T15308.stderr @@ -0,0 +1,5 @@ + +T15308.hs:12:5: error: + • No instance for (Show (Foo a f)) arising from a use of ‘show’ + • In the expression: show + In an equation for ‘f’: f = show diff --git a/testsuite/tests/dependent/should_fail/T15343.hs b/testsuite/tests/dependent/should_fail/T15343.hs new file mode 100644 index 0000000000..9bb59c807a --- /dev/null +++ b/testsuite/tests/dependent/should_fail/T15343.hs @@ -0,0 +1,14 @@ +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeInType #-} +module T15343 where + +import Data.Kind + +elimSing :: forall (p :: forall z. z). p +elimSing = undefined + +data WhySym :: Type -> Type + +hsym = elimSing @WhySym diff --git a/testsuite/tests/dependent/should_fail/T15343.stderr b/testsuite/tests/dependent/should_fail/T15343.stderr new file mode 100644 index 0000000000..79d81e5772 --- /dev/null +++ b/testsuite/tests/dependent/should_fail/T15343.stderr @@ -0,0 +1,7 @@ + +T15343.hs:14:18: error: + • Expecting one more argument to ‘WhySym’ + Expected kind ‘forall z. z’, but ‘WhySym’ has kind ‘* -> *’ + • In the type ‘WhySym’ + In the expression: elimSing @WhySym + In an equation for ‘hsym’: hsym = elimSing @WhySym diff --git a/testsuite/tests/dependent/should_fail/T15380.hs b/testsuite/tests/dependent/should_fail/T15380.hs new file mode 100644 index 0000000000..32ea8ec724 --- /dev/null +++ b/testsuite/tests/dependent/should_fail/T15380.hs @@ -0,0 +1,20 @@ +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeInType #-} +{-# LANGUAGE TypeOperators #-} + +module T15380 where + +import Data.Kind + +class Generic a where + type Rep a :: Type + +class PGeneric a where + type To a (x :: Rep a) :: a + +type family MDefault (x :: a) :: a where + MDefault x = To (M x) + +class C a where + type M (x :: a) :: a + type M (x :: a) = MDefault x diff --git a/testsuite/tests/dependent/should_fail/T15380.stderr b/testsuite/tests/dependent/should_fail/T15380.stderr new file mode 100644 index 0000000000..9b30078c64 --- /dev/null +++ b/testsuite/tests/dependent/should_fail/T15380.stderr @@ -0,0 +1,6 @@ + +T15380.hs:16:16: error: + • Expecting one more argument to ‘To (M x)’ + Expected a type, but ‘To (M x)’ has kind ‘Rep (M x) -> M x’ + • In the type ‘To (M x)’ + In the type family declaration for ‘MDefault’ diff --git a/testsuite/tests/dependent/should_fail/TypeSkolEscape.hs b/testsuite/tests/dependent/should_fail/TypeSkolEscape.hs index bbec037487..1f958de426 100644 --- a/testsuite/tests/dependent/should_fail/TypeSkolEscape.hs +++ b/testsuite/tests/dependent/should_fail/TypeSkolEscape.hs @@ -1,4 +1,5 @@ -{-# LANGUAGE RankNTypes, PolyKinds, TypeInType #-} +{-# LANGUAGE RankNTypes, PolyKinds #-} +-- NB: -fprint-explicit-runtime-reps enabled in all.T module TypeSkolEscape where diff --git a/testsuite/tests/dependent/should_fail/TypeSkolEscape.stderr b/testsuite/tests/dependent/should_fail/TypeSkolEscape.stderr index 88539858cf..e2ef266914 100644 --- a/testsuite/tests/dependent/should_fail/TypeSkolEscape.stderr +++ b/testsuite/tests/dependent/should_fail/TypeSkolEscape.stderr @@ -1,7 +1,5 @@ -TypeSkolEscape.hs:8:1: error: - • Quantified type's kind mentions quantified type variable - (skolem escape) - type: forall (a1 :: TYPE v1). a1 - of kind: TYPE v - • In the type synonym declaration for ‘Bad’ +TypeSkolEscape.hs:9:52: error: + • Expected kind ‘k0’, but ‘a’ has kind ‘TYPE v’ + • In the type ‘forall (v :: RuntimeRep) (a :: TYPE v). a’ + In the type declaration for ‘Bad’ diff --git a/testsuite/tests/dependent/should_fail/all.T b/testsuite/tests/dependent/should_fail/all.T index c648f9ed1d..0f7129020e 100644 --- a/testsuite/tests/dependent/should_fail/all.T +++ b/testsuite/tests/dependent/should_fail/all.T @@ -1,6 +1,6 @@ test('DepFail1', normal, compile_fail, ['']) test('RAE_T32a', normal, compile_fail, ['']) -test('TypeSkolEscape', normal, compile_fail, ['']) +test('TypeSkolEscape', normal, compile_fail, ['-fprint-explicit-runtime-reps']) test('BadTelescope', normal, compile_fail, ['']) test('BadTelescope2', normal, compile_fail, ['']) test('BadTelescope3', normal, compile_fail, ['']) @@ -10,10 +10,27 @@ test('BadTelescope4', normal, compile_fail, ['']) test('RenamingStar', normal, compile_fail, ['']) test('T11407', normal, compile_fail, ['']) test('T11334b', normal, compile_fail, ['']) -test('InferDependency', normal, compile_fail, ['']) -test('KindLevelsB', normal, compile_fail, ['']) test('T11473', normal, compile_fail, ['']) test('T11471', normal, compile_fail, ['']) test('T12174', normal, compile_fail, ['']) test('T12081', normal, compile_fail, ['']) test('T13135', normal, compile_fail, ['']) +test('T13601', normal, compile_fail, ['']) +test('T13780a', normal, compile_fail, ['']) +test('T13780c', [extra_files(['T13780b.hs'])], + multimod_compile_fail, ['T13780c', '']) +test('T13895', normal, compile_fail, ['']) +test('T14066', normal, compile_fail, ['']) +test('T14066c', normal, compile_fail, ['']) +test('T14066d', normal, compile_fail, ['']) +test('T14066e', normal, compile_fail, ['']) +test('T14066f', normal, compile_fail, ['']) +test('T14066g', normal, compile_fail, ['']) +test('T14845_fail1', normal, compile_fail, ['']) +test('T14845_fail2', normal, compile_fail, ['']) +test('InferDependency', normal, compile_fail, ['']) +test('T15245', normal, compile_fail, ['']) +test('T15215', normal, compile_fail, ['']) +test('T15308', normal, compile_fail, ['-fno-print-explicit-kinds']) +test('T15343', normal, compile_fail, ['']) +test('T15380', normal, compile_fail, ['']) diff --git a/testsuite/tests/dependent/should_run/T11964a.hs b/testsuite/tests/dependent/should_run/T11964a.hs index f0576542b6..2c6993fef0 100644 --- a/testsuite/tests/dependent/should_run/T11964a.hs +++ b/testsuite/tests/dependent/should_run/T11964a.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE TypeInType #-} +{-# LANGUAGE PolyKinds #-} module T11964a where import Data.Kind type Star = Type diff --git a/testsuite/tests/deriving/should_compile/AutoDeriveTypeable.hs b/testsuite/tests/deriving/should_compile/AutoDeriveTypeable.hs index 52e6c3823c..281b330337 100644 --- a/testsuite/tests/deriving/should_compile/AutoDeriveTypeable.hs +++ b/testsuite/tests/deriving/should_compile/AutoDeriveTypeable.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE AutoDeriveTypeable #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE PolyKinds #-} diff --git a/testsuite/tests/deriving/should_compile/T11416.hs b/testsuite/tests/deriving/should_compile/T11416.hs index 4696306107..210d0423b7 100644 --- a/testsuite/tests/deriving/should_compile/T11416.hs +++ b/testsuite/tests/deriving/should_compile/T11416.hs @@ -1,6 +1,7 @@ {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE TypeInType #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE PolyKinds #-} module T11416 where import Data.Kind diff --git a/testsuite/tests/deriving/should_compile/T11732a.hs b/testsuite/tests/deriving/should_compile/T11732a.hs index 54e1582642..e07fb6aafb 100644 --- a/testsuite/tests/deriving/should_compile/T11732a.hs +++ b/testsuite/tests/deriving/should_compile/T11732a.hs @@ -1,6 +1,6 @@ {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE TypeInType #-} +{-# LANGUAGE PolyKinds #-} module T11732a where import GHC.Generics diff --git a/testsuite/tests/deriving/should_compile/T11732b.hs b/testsuite/tests/deriving/should_compile/T11732b.hs index ba71ba5b30..8bd6388063 100644 --- a/testsuite/tests/deriving/should_compile/T11732b.hs +++ b/testsuite/tests/deriving/should_compile/T11732b.hs @@ -1,6 +1,6 @@ {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE TypeInType #-} +{-# LANGUAGE PolyKinds #-} module T11732b where data P1 (a :: k) = MkP1 deriving Functor diff --git a/testsuite/tests/deriving/should_compile/T11732c.hs b/testsuite/tests/deriving/should_compile/T11732c.hs index e013383f22..55553045c0 100644 --- a/testsuite/tests/deriving/should_compile/T11732c.hs +++ b/testsuite/tests/deriving/should_compile/T11732c.hs @@ -1,7 +1,7 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE TypeInType #-} +{-# LANGUAGE PolyKinds #-} module T11732c where import Data.Kind @@ -14,5 +14,10 @@ instance Cat * (->) where catId = id catComp = (.) -newtype Fun1 a b = Fun1 (a -> b) deriving (Cat k) newtype Fun2 a b = Fun2 (a -> b) deriving (Cat *) + +-- The ticket says this should work: +-- newtype Fun1 a b = Fun1 (a -> b) deriving (Cat k) +-- But that requires that the kind of (Cat k) to depend on k, where k is local +-- This is all due for an update, anyway, when #14331 is done, and it's unclear +-- what the correct behavior here is, anyway. (Richard thinks: reject!) diff --git a/testsuite/tests/deriving/should_compile/T13154a.hs b/testsuite/tests/deriving/should_compile/T13154a.hs new file mode 100644 index 0000000000..4d60785eb2 --- /dev/null +++ b/testsuite/tests/deriving/should_compile/T13154a.hs @@ -0,0 +1,14 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE StandaloneDeriving #-} +module T13154a where + +import GHC.Exts + +class C1 a +deriving instance C1 (a -> b) + +class C2 (a :: TYPE 'IntRep) +deriving instance C2 Int# diff --git a/testsuite/tests/deriving/should_compile/T13998.hs b/testsuite/tests/deriving/should_compile/T13998.hs new file mode 100644 index 0000000000..565d4a35f7 --- /dev/null +++ b/testsuite/tests/deriving/should_compile/T13998.hs @@ -0,0 +1,43 @@ +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DefaultSignatures #-} +{-# LANGUAGE GADTs #-} + +module T13998 where + +import Data.Type.Equality + +class EqForall f where + eqForall :: f a -> f a -> Bool + +class EqForall f => EqForallPoly f where + eqForallPoly :: f a -> f b -> Bool + default eqForallPoly :: TestEquality f => f a -> f b -> Bool + eqForallPoly = defaultEqForallPoly + +defaultEqForallPoly :: (TestEquality f, EqForall f) => f a -> f b -> Bool +defaultEqForallPoly x y = case testEquality x y of + Nothing -> False + Just Refl -> eqForall x y + + +data Atom = AtomInt | AtomString | AtomBool + +data Value (a :: Atom) where + ValueInt :: Int -> Value 'AtomInt + ValueString :: String -> Value 'AtomString + ValueBool :: Bool -> Value 'AtomBool + +instance TestEquality Value where + testEquality (ValueInt _) (ValueInt _) = Just Refl + testEquality (ValueString _) (ValueString _) = Just Refl + testEquality (ValueBool _) (ValueBool _) = Just Refl + testEquality _ _ = Nothing + +instance EqForall Value where + eqForall (ValueInt a) (ValueInt b) = a == b + eqForall (ValueString a) (ValueString b) = a == b + eqForall (ValueBool a) (ValueBool b) = a == b + +instance EqForallPoly Value diff --git a/testsuite/tests/deriving/should_compile/T14045b.hs b/testsuite/tests/deriving/should_compile/T14045b.hs new file mode 100644 index 0000000000..cb18e36029 --- /dev/null +++ b/testsuite/tests/deriving/should_compile/T14045b.hs @@ -0,0 +1,13 @@ +{-# LANGUAGE TypeFamilies, KindSignatures, GADTs, GeneralizedNewtypeDeriving #-} + +module T14045b where + +import Data.Kind ( Type ) + +data family T a b :: Type + +-- newtype instance T Int d = MkT (IO d) + +newtype instance T Int :: Type -> Type where + MkT :: IO d -> T Int d + deriving( Monad, Applicative, Functor ) diff --git a/testsuite/tests/deriving/should_compile/T14094.hs b/testsuite/tests/deriving/should_compile/T14094.hs new file mode 100644 index 0000000000..29fa693e97 --- /dev/null +++ b/testsuite/tests/deriving/should_compile/T14094.hs @@ -0,0 +1,13 @@ +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE TypeFamilies #-} +{-# OPTIONS_GHC -Wall #-} +module Bug where + +class C a where + type T a + data D a + m :: a + +instance C Int +deriving instance C Bool diff --git a/testsuite/tests/deriving/should_compile/T14094.stderr b/testsuite/tests/deriving/should_compile/T14094.stderr new file mode 100644 index 0000000000..b323a775f5 --- /dev/null +++ b/testsuite/tests/deriving/should_compile/T14094.stderr @@ -0,0 +1,26 @@ + +T14094.hs:12:1: warning: [-Wmissing-methods (in -Wdefault)] + • No explicit associated type or default declaration for ‘T’ + • In the instance declaration for ‘C Int’ + +T14094.hs:12:1: warning: [-Wmissing-methods (in -Wdefault)] + • No explicit associated type or default declaration for ‘D’ + • In the instance declaration for ‘C Int’ + +T14094.hs:12:10: warning: [-Wmissing-methods (in -Wdefault)] + • No explicit implementation for + ‘m’ + • In the instance declaration for ‘C Int’ + +T14094.hs:13:1: warning: [-Wmissing-methods (in -Wdefault)] + • No explicit associated type or default declaration for ‘T’ + • In the instance declaration for ‘C Bool’ + +T14094.hs:13:1: warning: [-Wmissing-methods (in -Wdefault)] + • No explicit associated type or default declaration for ‘D’ + • In the instance declaration for ‘C Bool’ + +T14094.hs:13:1: warning: [-Wmissing-methods (in -Wdefault)] + • No explicit implementation for + ‘m’ + • In the instance declaration for ‘C Bool’ diff --git a/testsuite/tests/deriving/should_compile/T14331.hs b/testsuite/tests/deriving/should_compile/T14331.hs new file mode 100644 index 0000000000..d3b52da9a2 --- /dev/null +++ b/testsuite/tests/deriving/should_compile/T14331.hs @@ -0,0 +1,10 @@ +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE PolyKinds #-} +module Bug where + +class C p q + +data D = D deriving (C (a :: k)) diff --git a/testsuite/tests/deriving/should_compile/T14339.hs b/testsuite/tests/deriving/should_compile/T14339.hs new file mode 100644 index 0000000000..e2521f2de0 --- /dev/null +++ b/testsuite/tests/deriving/should_compile/T14339.hs @@ -0,0 +1,17 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE UndecidableInstances #-} +module Bug where + +import GHC.TypeLits + +newtype Baz = Baz Foo + deriving Bar + +newtype Foo = Foo Int + +class Bar a where + bar :: a + +instance (TypeError (Text "Boo")) => Bar Foo where + bar = undefined diff --git a/testsuite/tests/deriving/should_compile/T14578.hs b/testsuite/tests/deriving/should_compile/T14578.hs new file mode 100644 index 0000000000..d0700ea9b0 --- /dev/null +++ b/testsuite/tests/deriving/should_compile/T14578.hs @@ -0,0 +1,15 @@ +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +module T14578 where + +import Control.Applicative +import Data.Functor.Compose +import Data.Semigroup + +newtype App f a = MkApp (f a) + deriving (Functor, Applicative) + +instance (Applicative f, Semigroup a) => Semigroup (App f a) where + (<>) = liftA2 (<>) + +newtype Wat f g a = MkWat (App (Compose f g) a) + deriving Semigroup diff --git a/testsuite/tests/deriving/should_compile/T14578.stderr b/testsuite/tests/deriving/should_compile/T14578.stderr new file mode 100644 index 0000000000..9f7ef67bf3 --- /dev/null +++ b/testsuite/tests/deriving/should_compile/T14578.stderr @@ -0,0 +1,116 @@ + +==================== Derived instances ==================== +Derived class instances: + instance GHC.Base.Functor f => + GHC.Base.Functor (T14578.App f) where + GHC.Base.fmap + = GHC.Prim.coerce + @((a -> b) -> f a -> f b) + @((a -> b) -> T14578.App f a -> T14578.App f b) + GHC.Base.fmap :: + forall (a :: TYPE GHC.Types.LiftedRep) + (b :: TYPE GHC.Types.LiftedRep). + (a -> b) -> T14578.App f a -> T14578.App f b + (GHC.Base.<$) + = GHC.Prim.coerce + @(a -> f b -> f a) + @(a -> T14578.App f b -> T14578.App f a) + (GHC.Base.<$) :: + forall (a :: TYPE GHC.Types.LiftedRep) + (b :: TYPE GHC.Types.LiftedRep). + a -> T14578.App f b -> T14578.App f a + + instance GHC.Base.Applicative f => + GHC.Base.Applicative (T14578.App f) where + GHC.Base.pure + = GHC.Prim.coerce + @(a -> f a) @(a -> T14578.App f a) GHC.Base.pure :: + forall (a :: TYPE GHC.Types.LiftedRep). a -> T14578.App f a + (GHC.Base.<*>) + = GHC.Prim.coerce + @(f (a -> b) -> f a -> f b) + @(T14578.App f (a -> b) -> T14578.App f a -> T14578.App f b) + (GHC.Base.<*>) :: + forall (a :: TYPE GHC.Types.LiftedRep) + (b :: TYPE GHC.Types.LiftedRep). + T14578.App f (a -> b) -> T14578.App f a -> T14578.App f b + GHC.Base.liftA2 + = GHC.Prim.coerce + @((a -> b -> c) -> f a -> f b -> f c) + @((a -> b -> c) + -> T14578.App f a -> T14578.App f b -> T14578.App f c) + GHC.Base.liftA2 :: + forall (a :: TYPE GHC.Types.LiftedRep) + (b :: TYPE GHC.Types.LiftedRep) + (c :: TYPE GHC.Types.LiftedRep). + (a -> b -> c) -> T14578.App f a -> T14578.App f b -> T14578.App f c + (GHC.Base.*>) + = GHC.Prim.coerce + @(f a -> f b -> f b) + @(T14578.App f a -> T14578.App f b -> T14578.App f b) + (GHC.Base.*>) :: + forall (a :: TYPE GHC.Types.LiftedRep) + (b :: TYPE GHC.Types.LiftedRep). + T14578.App f a -> T14578.App f b -> T14578.App f b + (GHC.Base.<*) + = GHC.Prim.coerce + @(f a -> f b -> f a) + @(T14578.App f a -> T14578.App f b -> T14578.App f a) + (GHC.Base.<*) :: + forall (a :: TYPE GHC.Types.LiftedRep) + (b :: TYPE GHC.Types.LiftedRep). + T14578.App f a -> T14578.App f b -> T14578.App f a + + instance (GHC.Base.Applicative f, GHC.Base.Applicative g, + GHC.Base.Semigroup a) => + GHC.Base.Semigroup (T14578.Wat f g a) where + (GHC.Base.<>) + = GHC.Prim.coerce + @(T14578.App (Data.Functor.Compose.Compose f g :: TYPE GHC.Types.LiftedRep + -> TYPE GHC.Types.LiftedRep) a + -> T14578.App (Data.Functor.Compose.Compose f g :: TYPE GHC.Types.LiftedRep + -> TYPE GHC.Types.LiftedRep) a + -> T14578.App (Data.Functor.Compose.Compose f g :: TYPE GHC.Types.LiftedRep + -> TYPE GHC.Types.LiftedRep) a) + @(T14578.Wat f g a -> T14578.Wat f g a -> T14578.Wat f g a) + (GHC.Base.<>) :: + T14578.Wat f g a -> T14578.Wat f g a -> T14578.Wat f g a + GHC.Base.sconcat + = GHC.Prim.coerce + @(GHC.Base.NonEmpty (T14578.App (Data.Functor.Compose.Compose f g :: TYPE GHC.Types.LiftedRep + -> TYPE GHC.Types.LiftedRep) a) + -> T14578.App (Data.Functor.Compose.Compose f g :: TYPE GHC.Types.LiftedRep + -> TYPE GHC.Types.LiftedRep) a) + @(GHC.Base.NonEmpty (T14578.Wat f g a) -> T14578.Wat f g a) + GHC.Base.sconcat :: + GHC.Base.NonEmpty (T14578.Wat f g a) -> T14578.Wat f g a + GHC.Base.stimes + = GHC.Prim.coerce + @(b + -> T14578.App (Data.Functor.Compose.Compose f g :: TYPE GHC.Types.LiftedRep + -> TYPE GHC.Types.LiftedRep) a + -> T14578.App (Data.Functor.Compose.Compose f g :: TYPE GHC.Types.LiftedRep + -> TYPE GHC.Types.LiftedRep) a) + @(b -> T14578.Wat f g a -> T14578.Wat f g a) + GHC.Base.stimes :: + forall (b :: TYPE GHC.Types.LiftedRep). + GHC.Real.Integral b => b -> T14578.Wat f g a -> T14578.Wat f g a + + +Derived type family instances: + + + +==================== Filling in method body ==================== +GHC.Base.Semigroup [T14578.App f[ssk:1] a[ssk:1]] + GHC.Base.sconcat = GHC.Base.$dmsconcat + @(T14578.App f[ssk:1] a[ssk:1]) + + + +==================== Filling in method body ==================== +GHC.Base.Semigroup [T14578.App f[ssk:1] a[ssk:1]] + GHC.Base.stimes = GHC.Base.$dmstimes + @(T14578.App f[ssk:1] a[ssk:1]) + + diff --git a/testsuite/tests/deriving/should_compile/T14579.hs b/testsuite/tests/deriving/should_compile/T14579.hs new file mode 100644 index 0000000000..518dffe214 --- /dev/null +++ b/testsuite/tests/deriving/should_compile/T14579.hs @@ -0,0 +1,13 @@ +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE PolyKinds #-} +module T14579 where + +import Data.Kind +import Data.Proxy + +newtype Wat (x :: Proxy (a :: Type)) = MkWat (Maybe a) + deriving Eq + +newtype Glurp a = MkGlurp (Wat ('Proxy :: Proxy a)) + deriving Eq diff --git a/testsuite/tests/deriving/should_compile/T14682.hs b/testsuite/tests/deriving/should_compile/T14682.hs new file mode 100644 index 0000000000..8f8161f00f --- /dev/null +++ b/testsuite/tests/deriving/should_compile/T14682.hs @@ -0,0 +1,10 @@ +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveLift #-} +module T14682 where + +import Data.Data +import Data.Ix +import Language.Haskell.TH.Syntax + +data Foo = Foo Int Int + deriving (Show, Lift, Data, Eq, Ord, Ix) diff --git a/testsuite/tests/deriving/should_compile/T14682.stderr b/testsuite/tests/deriving/should_compile/T14682.stderr new file mode 100644 index 0000000000..ed44b3c2b1 --- /dev/null +++ b/testsuite/tests/deriving/should_compile/T14682.stderr @@ -0,0 +1,194 @@ + +==================== Derived instances ==================== +Derived class instances: + instance GHC.Show.Show T14682.Foo where + GHC.Show.showsPrec a (T14682.Foo b1 b2) + = GHC.Show.showParen + (a GHC.Classes.>= 11) + ((GHC.Base..) + (GHC.Show.showString "Foo ") + ((GHC.Base..) + (GHC.Show.showsPrec 11 b1) + ((GHC.Base..) GHC.Show.showSpace (GHC.Show.showsPrec 11 b2)))) + + instance Language.Haskell.TH.Syntax.Lift T14682.Foo where + Language.Haskell.TH.Syntax.lift (T14682.Foo a1 a2) + = Language.Haskell.TH.Lib.Internal.appE + (Language.Haskell.TH.Lib.Internal.appE + (Language.Haskell.TH.Lib.Internal.conE + (Language.Haskell.TH.Syntax.mkNameG_d "main" "T14682" "Foo")) + (Language.Haskell.TH.Syntax.lift a1)) + (Language.Haskell.TH.Syntax.lift a2) + + instance Data.Data.Data T14682.Foo where + Data.Data.gfoldl k z (T14682.Foo a1 a2) + = ((z T14682.Foo `k` a1) `k` a2) + Data.Data.gunfold k z _ = k (k (z T14682.Foo)) + Data.Data.toConstr (T14682.Foo _ _) = T14682.$cFoo + Data.Data.dataTypeOf _ = T14682.$tFoo + + instance GHC.Classes.Eq T14682.Foo where + (GHC.Classes.==) (T14682.Foo a1 a2) (T14682.Foo b1 b2) + = (((a1 GHC.Classes.== b1)) + GHC.Classes.&& ((a2 GHC.Classes.== b2))) + + instance GHC.Classes.Ord T14682.Foo where + GHC.Classes.compare a b + = case a of { + T14682.Foo a1 a2 + -> case b of { + T14682.Foo b1 b2 + -> case (GHC.Classes.compare a1 b1) of + GHC.Types.LT -> GHC.Types.LT + GHC.Types.EQ -> (a2 `GHC.Classes.compare` b2) + GHC.Types.GT -> GHC.Types.GT } } + (GHC.Classes.<) a b + = case a of { + T14682.Foo a1 a2 + -> case b of { + T14682.Foo b1 b2 + -> case (GHC.Classes.compare a1 b1) of + GHC.Types.LT -> GHC.Types.True + GHC.Types.EQ -> (a2 GHC.Classes.< b2) + GHC.Types.GT -> GHC.Types.False } } + (GHC.Classes.<=) a b = GHC.Classes.not ((GHC.Classes.<) b a) + (GHC.Classes.>) a b = (GHC.Classes.<) b a + (GHC.Classes.>=) a b = GHC.Classes.not ((GHC.Classes.<) a b) + + instance GHC.Arr.Ix T14682.Foo where + GHC.Arr.range (T14682.Foo a1 a2, T14682.Foo b1 b2) + = [T14682.Foo c1 c2 | + c1 <- GHC.Arr.range (a1, b1), c2 <- GHC.Arr.range (a2, b2)] + GHC.Arr.unsafeIndex + (T14682.Foo a1 a2, T14682.Foo b1 b2) + (T14682.Foo c1 c2) + = (GHC.Arr.unsafeIndex (a2, b2) c2 + GHC.Num.+ + (GHC.Arr.unsafeRangeSize (a2, b2) + GHC.Num.* GHC.Arr.unsafeIndex (a1, b1) c1)) + GHC.Arr.inRange + (T14682.Foo a1 a2, T14682.Foo b1 b2) + (T14682.Foo c1 c2) + = (GHC.Arr.inRange (a1, b1) c1 + GHC.Classes.&& GHC.Arr.inRange (a2, b2) c2) + + T14682.$con2tag_B4iUvrAY4wB3YczpMJQUOX :: + T14682.Foo -> GHC.Prim.Int# + T14682.$con2tag_B4iUvrAY4wB3YczpMJQUOX (T14682.Foo _ _) = 0# + T14682.$tFoo :: Data.Data.DataType + T14682.$cFoo :: Data.Data.Constr + T14682.$tFoo = Data.Data.mkDataType "Foo" [T14682.$cFoo] + T14682.$cFoo + = Data.Data.mkConstr T14682.$tFoo "Foo" [] Data.Data.Prefix + +Derived type family instances: + + + +==================== Filling in method body ==================== +GHC.Show.Show [T14682.Foo] + GHC.Show.show = GHC.Show.$dmshow @(T14682.Foo) + + + +==================== Filling in method body ==================== +GHC.Show.Show [T14682.Foo] + GHC.Show.showList = GHC.Show.$dmshowList @(T14682.Foo) + + + +==================== Filling in method body ==================== +Data.Data.Data [T14682.Foo] + Data.Data.dataCast1 = Data.Data.$dmdataCast1 @(T14682.Foo) + + + +==================== Filling in method body ==================== +Data.Data.Data [T14682.Foo] + Data.Data.dataCast2 = Data.Data.$dmdataCast2 @(T14682.Foo) + + + +==================== Filling in method body ==================== +Data.Data.Data [T14682.Foo] + Data.Data.gmapT = Data.Data.$dmgmapT @(T14682.Foo) + + + +==================== Filling in method body ==================== +Data.Data.Data [T14682.Foo] + Data.Data.gmapQl = Data.Data.$dmgmapQl @(T14682.Foo) + + + +==================== Filling in method body ==================== +Data.Data.Data [T14682.Foo] + Data.Data.gmapQr = Data.Data.$dmgmapQr @(T14682.Foo) + + + +==================== Filling in method body ==================== +Data.Data.Data [T14682.Foo] + Data.Data.gmapQ = Data.Data.$dmgmapQ @(T14682.Foo) + + + +==================== Filling in method body ==================== +Data.Data.Data [T14682.Foo] + Data.Data.gmapQi = Data.Data.$dmgmapQi @(T14682.Foo) + + + +==================== Filling in method body ==================== +Data.Data.Data [T14682.Foo] + Data.Data.gmapM = Data.Data.$dmgmapM @(T14682.Foo) + + + +==================== Filling in method body ==================== +Data.Data.Data [T14682.Foo] + Data.Data.gmapMp = Data.Data.$dmgmapMp @(T14682.Foo) + + + +==================== Filling in method body ==================== +Data.Data.Data [T14682.Foo] + Data.Data.gmapMo = Data.Data.$dmgmapMo @(T14682.Foo) + + + +==================== Filling in method body ==================== +GHC.Classes.Eq [T14682.Foo] + GHC.Classes./= = GHC.Classes.$dm/= @(T14682.Foo) + + + +==================== Filling in method body ==================== +GHC.Classes.Ord [T14682.Foo] + GHC.Classes.max = GHC.Classes.$dmmax @(T14682.Foo) + + + +==================== Filling in method body ==================== +GHC.Classes.Ord [T14682.Foo] + GHC.Classes.min = GHC.Classes.$dmmin @(T14682.Foo) + + + +==================== Filling in method body ==================== +GHC.Arr.Ix [T14682.Foo] + GHC.Arr.index = GHC.Arr.$dmindex @(T14682.Foo) + + + +==================== Filling in method body ==================== +GHC.Arr.Ix [T14682.Foo] + GHC.Arr.rangeSize = GHC.Arr.$dmrangeSize @(T14682.Foo) + + + +==================== Filling in method body ==================== +GHC.Arr.Ix [T14682.Foo] + GHC.Arr.unsafeRangeSize = GHC.Arr.$dmunsafeRangeSize @(T14682.Foo) + + diff --git a/testsuite/tests/deriving/should_compile/T14883.hs b/testsuite/tests/deriving/should_compile/T14883.hs new file mode 100644 index 0000000000..0ec4b5f786 --- /dev/null +++ b/testsuite/tests/deriving/should_compile/T14883.hs @@ -0,0 +1,30 @@ +{-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE ImpredicativeTypes #-} +{-# LANGUAGE InstanceSigs #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE QuantifiedConstraints #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE TypeApplications #-} +module T14883 where + +import Data.Coerce +import Data.Kind + +type Representational1 m = (forall a b. Coercible a b => Coercible (m a) (m b) :: Constraint) + +class Representational1 f => Functor' f where + fmap' :: (a -> b) -> f a -> f b + +class Functor' f => Applicative' f where + pure' :: a -> f a + (<*>@) :: f (a -> b) -> f a -> f b + +class Functor' t => Traversable' t where + traverse' :: Applicative' f => (a -> f b) -> t a -> f (t b) + +-- Typechecks +newtype T1 m a = MkT1 (m a) deriving Functor' +deriving instance Traversable' m => Traversable' (T1 m) diff --git a/testsuite/tests/deriving/should_compile/T14932.hs b/testsuite/tests/deriving/should_compile/T14932.hs new file mode 100644 index 0000000000..bb82071bc2 --- /dev/null +++ b/testsuite/tests/deriving/should_compile/T14932.hs @@ -0,0 +1,23 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DefaultSignatures #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} +module T14932 where + +import Data.Kind (Constraint, Type) + +class Zero a where + zero :: a + default zero :: (Code a ~ '[xs], All Zero xs) => a + zero = undefined + +type family All c xs :: Constraint where + All c '[] = () + All c (x : xs) = (c x, All c xs) + +type family Code (a :: Type) :: [[Type]] +type instance Code B1 = '[ '[ ] ] + +data B1 = B1 + deriving Zero diff --git a/testsuite/tests/deriving/should_compile/T14933.hs b/testsuite/tests/deriving/should_compile/T14933.hs new file mode 100644 index 0000000000..2682d6242f --- /dev/null +++ b/testsuite/tests/deriving/should_compile/T14933.hs @@ -0,0 +1,22 @@ +{-# LANGUAGE DefaultSignatures #-} +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE TypeFamilies #-} +module T14933 where + +class Wrapped s where + type Unwrapped s :: * + +class Fork m where + fork :: (x, m) + + default fork :: ( Wrapped m + , Unwrapped m ~ t + , Fork t + ) => (x, m) + fork = undefined + +newtype MyThing m = MyThing m + deriving Fork + +instance Wrapped (MyThing m) where + type Unwrapped (MyThing m) = m diff --git a/testsuite/tests/deriving/should_compile/T15290c.hs b/testsuite/tests/deriving/should_compile/T15290c.hs new file mode 100644 index 0000000000..5aa9c7187e --- /dev/null +++ b/testsuite/tests/deriving/should_compile/T15290c.hs @@ -0,0 +1,20 @@ +{-# LANGUAGE QuantifiedConstraints, StandaloneDeriving, GeneralizedNewtypeDeriving #-} + +module T15290c where + +import Prelude hiding ( Monad(..) ) +import Data.Coerce ( Coercible ) + +class Monad m where + (>>=) :: m a -> (a -> m b) -> m b + join :: m (m a) -> m a + +newtype StateT s m a = StateT { runStateT :: s -> m (s, a) } + +instance Monad m => Monad (StateT s m) where + ma >>= fmb = StateT $ \s -> runStateT ma s >>= \(s1, a) -> runStateT (fmb a) s1 + join ssa = StateT $ \s -> runStateT ssa s >>= \(s, sa) -> runStateT sa s + +newtype IntStateT m a = IntStateT { runIntStateT :: StateT Int m a } + +deriving instance (Monad m, forall p q. Coercible p q => Coercible (m p) (m q)) => Monad (IntStateT m) diff --git a/testsuite/tests/deriving/should_compile/T15290d.hs b/testsuite/tests/deriving/should_compile/T15290d.hs new file mode 100644 index 0000000000..f9fceb8aa4 --- /dev/null +++ b/testsuite/tests/deriving/should_compile/T15290d.hs @@ -0,0 +1,12 @@ +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE RankNTypes #-} +module T15290d where + +class C a where + c :: Int -> forall b. b -> a + +instance C Int where + c _ _ = 42 + +newtype Age = MkAge Int + deriving C diff --git a/testsuite/tests/deriving/should_compile/T15398.hs b/testsuite/tests/deriving/should_compile/T15398.hs new file mode 100644 index 0000000000..b78df1fa17 --- /dev/null +++ b/testsuite/tests/deriving/should_compile/T15398.hs @@ -0,0 +1,20 @@ +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE StandaloneDeriving #-} + +module T15398 where + +newtype Radius a = Radius a deriving (Eq, Ord) + +data CourseLine +data OpenDistance +data EndOfSpeedSection + +data Zone k a where + Point :: (Eq a, Ord a) => Zone CourseLine a + Vector :: (Eq a, Ord a) => Zone OpenDistance a + Conical :: (Eq a, Ord a) => Radius a -> Zone EndOfSpeedSection a + +deriving instance Eq a => Eq (Zone k a) +deriving instance (Eq a, Ord a) => Ord (Zone k a) diff --git a/testsuite/tests/deriving/should_compile/T7710.hs b/testsuite/tests/deriving/should_compile/T7710.hs index 5375c2c0eb..9a5af946ac 100644 --- a/testsuite/tests/deriving/should_compile/T7710.hs +++ b/testsuite/tests/deriving/should_compile/T7710.hs @@ -1,6 +1,5 @@ {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE TypeSynonymInstances #-} -{-# LANGUAGE AutoDeriveTypeable #-} {-# LANGUAGE TypeFamilies #-} module T7710 where diff --git a/testsuite/tests/deriving/should_compile/T8128.hs b/testsuite/tests/deriving/should_compile/T8128.hs new file mode 100644 index 0000000000..624702e2a8 --- /dev/null +++ b/testsuite/tests/deriving/should_compile/T8128.hs @@ -0,0 +1,9 @@ +{-# LANGUAGE StandaloneDeriving, GADTs, FlexibleInstances #-} + +module T8128 where + +data T a where + MkT1 :: T Int + MkT2 :: Bool -> T Bool + +deriving instance Show (T Int) diff --git a/testsuite/tests/deriving/should_compile/T8740.hs b/testsuite/tests/deriving/should_compile/T8740.hs new file mode 100644 index 0000000000..95a114cd3a --- /dev/null +++ b/testsuite/tests/deriving/should_compile/T8740.hs @@ -0,0 +1,17 @@ +{-# LANGUAGE GADTs #-} +{-# LANGUAGE StandaloneDeriving #-} +module T8740 where + +data Abstract +data Reified +data Player + +data Elect p a where + ElectRefAsTypeOf :: Int -> Elect Abstract a -> Elect Abstract a + ElectHandle :: a -> Elect Reified a + Controller :: Elect Abstract Player + Owner :: Elect Abstract Player + You :: Elect Abstract Player + +deriving instance (Eq a) => Eq (Elect p a) +deriving instance (Ord a) => Ord (Elect p a) diff --git a/testsuite/tests/deriving/should_compile/T8950.hs b/testsuite/tests/deriving/should_compile/T8950.hs index b913b27aa8..58c6590b0e 100644 --- a/testsuite/tests/deriving/should_compile/T8950.hs +++ b/testsuite/tests/deriving/should_compile/T8950.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE AutoDeriveTypeable, DataKinds, StandaloneDeriving #-} +{-# LANGUAGE DataKinds, StandaloneDeriving #-} module T8950 where diff --git a/testsuite/tests/deriving/should_compile/all.T b/testsuite/tests/deriving/should_compile/all.T index 7c7b29070b..cc0730f4e0 100644 --- a/testsuite/tests/deriving/should_compile/all.T +++ b/testsuite/tests/deriving/should_compile/all.T @@ -36,6 +36,8 @@ test('T5939', normal, compile, ['']) test('drv-functor1', normal, compile, ['']) test('drv-functor2', normal, compile, ['']) test('drv-foldable-traversable1', normal, compile, ['']) +test('deriving-via-compile', normal, compile, ['']) +test('deriving-via-standalone', normal, compile, ['']) test('T6031', [], multimod_compile, ['T6031', '-v0 -O']) # Adding -O on T6031 to expose Trac #11245 regardless of way test('T1133', [], run_command, ['$MAKE --no-print-directory -s T1133']) @@ -44,11 +46,13 @@ test('T7710', normal, compile, ['']) test('AutoDeriveTypeable', normal, compile, ['']) +test('T8128', normal, compile, ['']) test('T8138', reqlib('primitive'), compile, ['-O2']) test('T8165', normal, compile, ['']) test('T8631', normal, compile, ['']) test('T8758', [], multimod_compile, ['T8758a', '-v0']) test('T8678', normal, compile, ['']) +test('T8740', normal, compile, ['']) test('T8865', normal, compile, ['']) test('T8893', normal, compile, ['']) test('T8950', normal, compile, ['']) @@ -85,6 +89,7 @@ test('T12594', normal, compile, ['']) test('T12616', normal, compile, ['']) test('T12688', normal, compile, ['']) test('T12814', normal, compile, ['-Wredundant-constraints']) +test('T13154a', normal, compile, ['']) test('T13272', normal, compile, ['']) test('T13272a', normal, compile, ['']) test('T13297', normal, compile, ['']) @@ -93,3 +98,17 @@ test('drv-empty-data', [normalise_errmsg_fun(just_the_deriving)],compile, ['-ddu test('drv-phantom', [normalise_errmsg_fun(just_the_deriving)],compile, ['-ddump-deriv -dsuppress-uniques']) test('T13813', normal, compile, ['']) test('T13919', normal, compile, ['']) +test('T13998', normal, compile, ['']) +test('T14045b', normal, compile, ['']) +test('T14094', normal, compile, ['']) +test('T14339', normal, compile, ['']) +test('T14331', normal, compile, ['']) +test('T14578', normal, compile, ['-ddump-deriv -dsuppress-uniques']) +test('T14579', normal, compile, ['']) +test('T14682', normal, compile, ['-ddump-deriv -dsuppress-uniques']) +test('T14883', normal, compile, ['']) +test('T14932', normal, compile, ['']) +test('T14933', normal, compile, ['']) +test('T15290c', normal, compile, ['']) +test('T15290d', normal, compile, ['']) +test('T15398', normal, compile, ['']) diff --git a/testsuite/tests/deriving/should_compile/deriving-via-compile.hs b/testsuite/tests/deriving/should_compile/deriving-via-compile.hs new file mode 100644 index 0000000000..b679acb8cd --- /dev/null +++ b/testsuite/tests/deriving/should_compile/deriving-via-compile.hs @@ -0,0 +1,459 @@ +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE DerivingVia #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE InstanceSigs #-} +{-# LANGUAGE TypeInType #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE MultiWayIf #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE UndecidableInstances #-} +module DerivingViaCompile where + +import Data.Void +import Data.Complex +import Data.Functor.Const +import Data.Functor.Identity +import Data.Ratio +import Control.Monad.Reader +import Control.Monad.State +import Control.Monad.Writer +import Control.Applicative hiding (WrappedMonad(..)) + +import Data.Bifunctor +import Data.Monoid +import Data.Kind + +type f ~> g = forall xx. f xx -> g xx + +----- +-- Simple example +----- + +data Foo a = MkFoo a a + deriving Show + via (Identity (Foo a)) + +----- +-- Eta reduction at work +----- + +newtype Flip p a b = Flip { runFlip :: p b a } + +instance Bifunctor p => Bifunctor (Flip p) where + bimap f g = Flip . bimap g f . runFlip + +instance Bifunctor p => Functor (Flip p a) where + fmap f = Flip . first f . runFlip + +newtype Bar a = MkBar (Either a Int) + deriving Functor + via (Flip Either Int) + +----- +-- Monad transformers +----- + +type MTrans = (Type -> Type) -> (Type -> Type) + +-- From `constraints' +data Dict c where + Dict :: c => Dict c + +newtype a :- b = Sub (a => Dict b) + +infixl 1 \\ +(\\) :: a => (b => r) -> (a :- b) -> r +r \\ Sub Dict = r + +-- With `-XQuantifiedConstraints' this just becomes +-- +-- type Lifting cls trans = forall mm. cls mm => cls (trans mm) +-- +-- type LiftingMonad trans = Lifting Monad trans +-- +class LiftingMonad (trans :: MTrans) where + proof :: Monad m :- Monad (trans m) + +instance LiftingMonad (StateT s :: MTrans) where + proof :: Monad m :- Monad (StateT s m) + proof = Sub Dict + +instance Monoid w => LiftingMonad (WriterT w :: MTrans) where + proof :: Monad m :- Monad (WriterT w m) + proof = Sub Dict + +instance (LiftingMonad trans, LiftingMonad trans') => LiftingMonad (ComposeT trans trans' :: MTrans) where + proof :: forall m. Monad m :- Monad (ComposeT trans trans' m) + proof = Sub (Dict \\ proof @trans @(trans' m) \\ proof @trans' @m) + +newtype Stack :: MTrans where + Stack :: ReaderT Int (StateT Bool (WriterT String m)) a -> Stack m a + deriving newtype + ( Functor + , Applicative + , Monad + , MonadReader Int + , MonadState Bool + , MonadWriter String + ) + deriving (MonadTrans, MFunctor) + via (ReaderT Int `ComposeT` StateT Bool `ComposeT` WriterT String) + +class MFunctor (trans :: MTrans) where + hoist :: Monad m => (m ~> m') -> (trans m ~> trans m') + +instance MFunctor (ReaderT r :: MTrans) where + hoist :: Monad m => (m ~> m') -> (ReaderT r m ~> ReaderT r m') + hoist nat = ReaderT . fmap nat . runReaderT + +instance MFunctor (StateT s :: MTrans) where + hoist :: Monad m => (m ~> m') -> (StateT s m ~> StateT s m') + hoist nat = StateT . fmap nat . runStateT + +instance MFunctor (WriterT w :: MTrans) where + hoist :: Monad m => (m ~> m') -> (WriterT w m ~> WriterT w m') + hoist nat = WriterT . nat . runWriterT + +infixr 9 `ComposeT` +newtype ComposeT :: MTrans -> MTrans -> MTrans where + ComposeT :: { getComposeT :: f (g m) a } -> ComposeT f g m a + deriving newtype (Functor, Applicative, Monad) + +instance (MonadTrans f, MonadTrans g, LiftingMonad g) => MonadTrans (ComposeT f g) where + lift :: forall m. Monad m => m ~> ComposeT f g m + lift = ComposeT . lift . lift + \\ proof @g @m + +instance (MFunctor f, MFunctor g, LiftingMonad g) => MFunctor (ComposeT f g) where + hoist :: forall m m'. Monad m => (m ~> m') -> (ComposeT f g m ~> ComposeT f g m') + hoist f = ComposeT . hoist (hoist f) . getComposeT + \\ proof @g @m + +----- +-- Using tuples in a `via` type +----- + +newtype X a = X (a, a) + deriving (Semigroup, Monoid) + via (Product a, Sum a) + + deriving (Show, Eq) + via (a, a) + +----- +-- Abstract data types +----- + +class C f where + c :: f a -> Int + +newtype X2 f a = X2 (f a) + +instance C (X2 f) where + c = const 0 + +deriving via (X2 IO) instance C IO + +---- +-- Testing parser +---- + +newtype P0 a = P0 a deriving Show via a +newtype P1 a = P1 [a] deriving Show via [a] +newtype P2 a = P2 (a, a) deriving Show via (a, a) +newtype P3 a = P3 (Maybe a) deriving Show via (First a) +newtype P4 a = P4 (Maybe a) deriving Show via (First $ a) +newtype P5 a = P5 a deriving Show via (Identity $ a) +newtype P6 a = P6 [a] deriving Show via ([] $ a) +newtype P7 a = P7 (a, a) deriving Show via (Identity $ (a, a)) +newtype P8 a = P8 (Either () a) deriving Functor via (($) (Either ())) + +newtype f $ a = APP (f a) deriving newtype Show deriving newtype Functor + +---- +-- From Baldur's notes +---- + +---- +-- 1 +---- +newtype WrapApplicative f a = WrappedApplicative (f a) + deriving (Functor, Applicative) + +instance (Applicative f, Num a) => Num (WrapApplicative f a) where + (+) = liftA2 (+) + (*) = liftA2 (*) + negate = fmap negate + fromInteger = pure . fromInteger + abs = fmap abs + signum = fmap signum + +instance (Applicative f, Fractional a) => Fractional (WrapApplicative f a) where + recip = fmap recip + fromRational = pure . fromRational + +instance (Applicative f, Floating a) => Floating (WrapApplicative f a) where + pi = pure pi + sqrt = fmap sqrt + exp = fmap exp + log = fmap log + sin = fmap sin + cos = fmap cos + asin = fmap asin + atan = fmap atan + acos = fmap acos + sinh = fmap sinh + cosh = fmap cosh + asinh = fmap asinh + atanh = fmap atanh + acosh = fmap acosh + +instance (Applicative f, Semigroup s) => Semigroup (WrapApplicative f s) where + (<>) = liftA2 (<>) + +instance (Applicative f, Monoid m) => Monoid (WrapApplicative f m) where + mempty = pure mempty + +---- +-- 2 +---- +class Pointed p where + pointed :: a -> p a + +newtype WrapMonad f a = WrappedMonad (f a) + deriving newtype (Pointed, Monad) + +instance (Monad m, Pointed m) => Functor (WrapMonad m) where + fmap = liftM + +instance (Monad m, Pointed m) => Applicative (WrapMonad m) where + pure = pointed + (<*>) = ap + +-- data +data Sorted a = Sorted a a a + deriving (Functor, Applicative) + via (WrapMonad Sorted) + deriving (Num, Fractional, Floating, Semigroup, Monoid) + via (WrapApplicative Sorted a) + + +instance Monad Sorted where + (>>=) :: Sorted a -> (a -> Sorted b) -> Sorted b + Sorted a b c >>= f = Sorted a' b' c' where + Sorted a' _ _ = f a + Sorted _ b' _ = f b + Sorted _ _ c' = f c + +instance Pointed Sorted where + pointed :: a -> Sorted a + pointed a = Sorted a a a + +---- +-- 3 +---- +class IsZero a where + isZero :: a -> Bool + +newtype WrappedNumEq a = WrappedNumEq a +newtype WrappedShow a = WrappedShow a +newtype WrappedNumEq2 a = WrappedNumEq2 a + +instance (Num a, Eq a) => IsZero (WrappedNumEq a) where + isZero :: WrappedNumEq a -> Bool + isZero (WrappedNumEq a) = 0 == a + +instance Show a => IsZero (WrappedShow a) where + isZero :: WrappedShow a -> Bool + isZero (WrappedShow a) = "0" == show a + +instance (Num a, Eq a) => IsZero (WrappedNumEq2 a) where + isZero :: WrappedNumEq2 a -> Bool + isZero (WrappedNumEq2 a) = a + a == a + +newtype INT = INT Int + deriving newtype Show + deriving IsZero via (WrappedNumEq Int) + +newtype VOID = VOID Void deriving IsZero via (WrappedShow Void) + +---- +-- 4 +---- +class Bifunctor p => Biapplicative p where + bipure :: a -> b -> p a b + + biliftA2 + :: (a -> b -> c) + -> (a' -> b' -> c') + -> p a a' + -> p b b' + -> p c c' + +instance Biapplicative (,) where + bipure = (,) + + biliftA2 f f' (a, a') (b, b') = + (f a b, f' a' b') + +newtype WrapBiapp p a b = WrapBiap (p a b) + deriving newtype (Bifunctor, Biapplicative, Eq) + +instance (Biapplicative p, Num a, Num b) => Num (WrapBiapp p a b) where + (+) = biliftA2 (+) (+) + (-) = biliftA2 (*) (*) + (*) = biliftA2 (*) (*) + negate = bimap negate negate + abs = bimap abs abs + signum = bimap signum signum + fromInteger n = fromInteger n `bipure` fromInteger n + +newtype INT2 = INT2 (Int, Int) + deriving IsZero via (WrappedNumEq2 (WrapBiapp (,) Int Int)) + +---- +-- 5 +---- +class Monoid a => MonoidNull a where + null :: a -> Bool + +newtype WrpMonNull a = WRM a deriving (Eq, Semigroup, Monoid) + +instance (Eq a, Monoid a) => MonoidNull (WrpMonNull a) where + null :: WrpMonNull a -> Bool + null = (== mempty) + +deriving via (WrpMonNull Any) instance MonoidNull Any +deriving via () instance MonoidNull () +deriving via Ordering instance MonoidNull Ordering + +---- +-- 6 +---- +-- https://github.com/mikeizbicki/subhask/blob/f53fd8f465747681c88276c7dabe3646fbdf7d50/src/SubHask/Algebra.hs#L635 + +class Lattice a where + sup :: a -> a -> a + (.>=) :: a -> a -> Bool + (.>) :: a -> a -> Bool + +newtype WrapOrd a = WrappedOrd a + deriving newtype (Eq, Ord) + +instance Ord a => Lattice (WrapOrd a) where + sup = max + (.>=) = (>=) + (.>) = (>) + +deriving via [a] instance Ord a => Lattice [a] +deriving via (a, b) instance (Ord a, Ord b) => Lattice (a, b) +--mkLattice_(Bool) +deriving via Bool instance Lattice Bool +--mkLattice_(Char) +deriving via Char instance Lattice Char +--mkLattice_(Int) +deriving via Int instance Lattice Int +--mkLattice_(Integer) +deriving via Integer instance Lattice Integer +--mkLattice_(Float) +deriving via Float instance Lattice Float +--mkLattice_(Double) +deriving via Double instance Lattice Double +--mkLattice_(Rational) +deriving via Rational instance Lattice Rational + +---- +-- 7 +---- +-- https://hackage.haskell.org/package/linear-1.20.7/docs/src/Linear-Affine.html + +class Functor f => Additive f where + zero :: Num a => f a + (^+^) :: Num a => f a -> f a -> f a + (^+^) = liftU2 (+) + (^-^) :: Num a => f a -> f a -> f a + x ^-^ y = x ^+^ fmap negate y + liftU2 :: (a -> a -> a) -> f a -> f a -> f a + +instance Additive [] where + zero = [] + liftU2 f = go where + go (x:xs) (y:ys) = f x y : go xs ys + go [] ys = ys + go xs [] = xs + +instance Additive Maybe where + zero = Nothing + liftU2 f (Just a) (Just b) = Just (f a b) + liftU2 _ Nothing ys = ys + liftU2 _ xs Nothing = xs + +instance Applicative f => Additive (WrapApplicative f) where + zero = pure 0 + liftU2 = liftA2 + +deriving via (WrapApplicative ((->) a)) instance Additive ((->) a) +deriving via (WrapApplicative Complex) instance Additive Complex +deriving via (WrapApplicative Identity) instance Additive Identity + +instance Additive ZipList where + zero = ZipList [] + liftU2 f (ZipList xs) (ZipList ys) = ZipList (liftU2 f xs ys) + +class Additive (Diff p) => Affine p where + type Diff p :: Type -> Type + + (.-.) :: Num a => p a -> p a -> Diff p a + (.+^) :: Num a => p a -> Diff p a -> p a + (.-^) :: Num a => p a -> Diff p a -> p a + p .-^ v = p .+^ fmap negate v + +-- #define ADDITIVEC(CTX,T) instance CTX => Affine T where type Diff T = T ; \ +-- (.-.) = (^-^) ; {-# INLINE (.-.) #-} ; (.+^) = (^+^) ; {-# INLINE (.+^) #-} ; \ +-- (.-^) = (^-^) ; {-# INLINE (.-^) #-} +-- #define ADDITIVE(T) ADDITIVEC((), T) +newtype WrapAdditive f a = WrappedAdditive (f a) + +instance Additive f => Affine (WrapAdditive f) where + type Diff (WrapAdditive f) = f + + WrappedAdditive a .-. WrappedAdditive b = a ^-^ b + WrappedAdditive a .+^ b = WrappedAdditive (a ^+^ b) + WrappedAdditive a .-^ b = WrappedAdditive (a ^-^ b) + +-- ADDITIVE(((->) a)) +deriving via (WrapAdditive ((->) a)) instance Affine ((->) a) +-- ADDITIVE([]) +deriving via (WrapAdditive []) instance Affine [] +-- ADDITIVE(Complex) +deriving via (WrapAdditive Complex) instance Affine Complex +-- ADDITIVE(Maybe) +deriving via (WrapAdditive Maybe) instance Affine Maybe +-- ADDITIVE(ZipList) +deriving via (WrapAdditive ZipList) instance Affine ZipList +-- ADDITIVE(Identity) +deriving via (WrapAdditive Identity) instance Affine Identity + +---- +-- 8 +---- + +class C2 a b c where + c2 :: a -> b -> c + +instance C2 a b (Const a b) where + c2 x _ = Const x + +newtype Fweemp a = Fweemp a + deriving (C2 a b) + via (Const a (b :: Type)) diff --git a/testsuite/tests/deriving/should_compile/deriving-via-standalone.hs b/testsuite/tests/deriving/should_compile/deriving-via-standalone.hs new file mode 100644 index 0000000000..0fa71d7e36 --- /dev/null +++ b/testsuite/tests/deriving/should_compile/deriving-via-standalone.hs @@ -0,0 +1,41 @@ +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE DerivingVia #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE StandaloneDeriving #-} +module DerivingViaStandalone where + +import Control.Applicative +import Data.Functor.Compose +import Data.Proxy +import Data.Semigroup + +newtype App (f :: * -> *) a = App (f a) + deriving newtype + (Functor, Applicative) + +instance (Applicative f, Semigroup a) => Semigroup (App f a) where + (<>) = liftA2 (<>) + +deriving via (App (Compose (f :: * -> *) g) a) + instance (Applicative f, Applicative g, Semigroup a) + => Semigroup (Compose f g a) + +class C (a :: k -> *) +instance C Proxy + +newtype MyProxy a = MyProxy (Proxy a) +deriving via (Proxy :: * -> *) instance C MyProxy + +class Z a b +data T a +data X1 a +data X2 a +data X3 a + +deriving via (forall a. T a) instance Z a (X1 b) +deriving via (T a) instance forall b. Z a (X2 b) +deriving via (forall a. T a) instance forall b. Z a (X3 b) diff --git a/testsuite/tests/deriving/should_compile/drv-empty-data.stderr b/testsuite/tests/deriving/should_compile/drv-empty-data.stderr index 47d5a984ab..5baf6a6c6e 100644 --- a/testsuite/tests/deriving/should_compile/drv-empty-data.stderr +++ b/testsuite/tests/deriving/should_compile/drv-empty-data.stderr @@ -2,25 +2,24 @@ ==================== Derived instances ==================== Derived class instances: instance GHC.Read.Read (DrvEmptyData.Void a) where - GHC.Read.readPrec - = GHC.Read.parens Text.ParserCombinators.ReadPrec.pfail + GHC.Read.readPrec = Text.ParserCombinators.ReadPrec.pfail GHC.Read.readList = GHC.Read.readListDefault GHC.Read.readListPrec = GHC.Read.readListPrecDefault instance GHC.Show.Show (DrvEmptyData.Void a) where - GHC.Show.showsPrec _ = GHC.Err.error "Void showsPrec" + GHC.Show.showsPrec _ z = case z of instance GHC.Classes.Ord (DrvEmptyData.Void a) where - GHC.Classes.compare _ _ = GHC.Err.error "Void compare" + GHC.Classes.compare _ z = GHC.Types.EQ instance GHC.Classes.Eq (DrvEmptyData.Void a) where - (GHC.Classes.==) _ _ = GHC.Err.error "Void ==" + (GHC.Classes.==) _ z = GHC.Types.True instance Data.Data.Data a => Data.Data.Data (DrvEmptyData.Void a) where - Data.Data.gfoldl _ _ _ = GHC.Err.error "Void gfoldl" + Data.Data.gfoldl _ _ z = case z of Data.Data.gunfold k z c = case Data.Data.constrIndex c of - Data.Data.toConstr _ = GHC.Err.error "Void toConstr" + Data.Data.toConstr z = case z of Data.Data.dataTypeOf _ = DrvEmptyData.$tVoid Data.Data.dataCast1 f = Data.Typeable.gcast1 f @@ -46,8 +45,7 @@ Derived class instances: instance Language.Haskell.TH.Syntax.Lift (DrvEmptyData.Void a) where - Language.Haskell.TH.Syntax.lift _ - = GHC.Err.error "Can't lift value of empty datatype Void" + Language.Haskell.TH.Syntax.lift z = GHC.Base.pure (case z of) DrvEmptyData.$tVoid :: Data.Data.DataType DrvEmptyData.$tVoid = Data.Data.mkDataType "Void" [] @@ -65,3 +63,237 @@ Derived type family instances: ==================== Filling in method body ==================== +GHC.Read.Read [DrvEmptyData.Void a[ssk:2]] + GHC.Read.readsPrec = GHC.Read.$dmreadsPrec + @(DrvEmptyData.Void a[ssk:2]) + + + +==================== Filling in method body ==================== +GHC.Show.Show [DrvEmptyData.Void a[ssk:2]] + GHC.Show.show = GHC.Show.$dmshow @(DrvEmptyData.Void a[ssk:2]) + + + +==================== Filling in method body ==================== +GHC.Show.Show [DrvEmptyData.Void a[ssk:2]] + GHC.Show.showList = GHC.Show.$dmshowList + @(DrvEmptyData.Void a[ssk:2]) + + + +==================== Filling in method body ==================== +GHC.Classes.Ord [DrvEmptyData.Void a[ssk:2]] + GHC.Classes.< = GHC.Classes.$dm< @(DrvEmptyData.Void a[ssk:2]) + + + +==================== Filling in method body ==================== +GHC.Classes.Ord [DrvEmptyData.Void a[ssk:2]] + GHC.Classes.<= = GHC.Classes.$dm<= @(DrvEmptyData.Void a[ssk:2]) + + + +==================== Filling in method body ==================== +GHC.Classes.Ord [DrvEmptyData.Void a[ssk:2]] + GHC.Classes.> = GHC.Classes.$dm> @(DrvEmptyData.Void a[ssk:2]) + + + +==================== Filling in method body ==================== +GHC.Classes.Ord [DrvEmptyData.Void a[ssk:2]] + GHC.Classes.>= = GHC.Classes.$dm>= @(DrvEmptyData.Void a[ssk:2]) + + + +==================== Filling in method body ==================== +GHC.Classes.Ord [DrvEmptyData.Void a[ssk:2]] + GHC.Classes.max = GHC.Classes.$dmmax @(DrvEmptyData.Void a[ssk:2]) + + + +==================== Filling in method body ==================== +GHC.Classes.Ord [DrvEmptyData.Void a[ssk:2]] + GHC.Classes.min = GHC.Classes.$dmmin @(DrvEmptyData.Void a[ssk:2]) + + + +==================== Filling in method body ==================== +GHC.Classes.Eq [DrvEmptyData.Void a[ssk:2]] + GHC.Classes./= = GHC.Classes.$dm/= @(DrvEmptyData.Void a[ssk:2]) + + + +==================== Filling in method body ==================== +Data.Data.Data [DrvEmptyData.Void a[ssk:2]] + Data.Data.dataCast2 = Data.Data.$dmdataCast2 + @(DrvEmptyData.Void a[ssk:2]) + + + +==================== Filling in method body ==================== +Data.Data.Data [DrvEmptyData.Void a[ssk:2]] + Data.Data.gmapT = Data.Data.$dmgmapT @(DrvEmptyData.Void a[ssk:2]) + + + +==================== Filling in method body ==================== +Data.Data.Data [DrvEmptyData.Void a[ssk:2]] + Data.Data.gmapQl = Data.Data.$dmgmapQl + @(DrvEmptyData.Void a[ssk:2]) + + + +==================== Filling in method body ==================== +Data.Data.Data [DrvEmptyData.Void a[ssk:2]] + Data.Data.gmapQr = Data.Data.$dmgmapQr + @(DrvEmptyData.Void a[ssk:2]) + + + +==================== Filling in method body ==================== +Data.Data.Data [DrvEmptyData.Void a[ssk:2]] + Data.Data.gmapQ = Data.Data.$dmgmapQ @(DrvEmptyData.Void a[ssk:2]) + + + +==================== Filling in method body ==================== +Data.Data.Data [DrvEmptyData.Void a[ssk:2]] + Data.Data.gmapQi = Data.Data.$dmgmapQi + @(DrvEmptyData.Void a[ssk:2]) + + + +==================== Filling in method body ==================== +Data.Data.Data [DrvEmptyData.Void a[ssk:2]] + Data.Data.gmapM = Data.Data.$dmgmapM @(DrvEmptyData.Void a[ssk:2]) + + + +==================== Filling in method body ==================== +Data.Data.Data [DrvEmptyData.Void a[ssk:2]] + Data.Data.gmapMp = Data.Data.$dmgmapMp + @(DrvEmptyData.Void a[ssk:2]) + + + +==================== Filling in method body ==================== +Data.Data.Data [DrvEmptyData.Void a[ssk:2]] + Data.Data.gmapMo = Data.Data.$dmgmapMo + @(DrvEmptyData.Void a[ssk:2]) + + + +==================== Filling in method body ==================== +Data.Foldable.Foldable [DrvEmptyData.Void] + Data.Foldable.fold = Data.Foldable.$dmfold @(DrvEmptyData.Void) + + + +==================== Filling in method body ==================== +Data.Foldable.Foldable [DrvEmptyData.Void] + Data.Foldable.foldr = Data.Foldable.$dmfoldr @(DrvEmptyData.Void) + + + +==================== Filling in method body ==================== +Data.Foldable.Foldable [DrvEmptyData.Void] + Data.Foldable.foldr' = Data.Foldable.$dmfoldr' @(DrvEmptyData.Void) + + + +==================== Filling in method body ==================== +Data.Foldable.Foldable [DrvEmptyData.Void] + Data.Foldable.foldl = Data.Foldable.$dmfoldl @(DrvEmptyData.Void) + + + +==================== Filling in method body ==================== +Data.Foldable.Foldable [DrvEmptyData.Void] + Data.Foldable.foldl' = Data.Foldable.$dmfoldl' @(DrvEmptyData.Void) + + + +==================== Filling in method body ==================== +Data.Foldable.Foldable [DrvEmptyData.Void] + Data.Foldable.foldr1 = Data.Foldable.$dmfoldr1 @(DrvEmptyData.Void) + + + +==================== Filling in method body ==================== +Data.Foldable.Foldable [DrvEmptyData.Void] + Data.Foldable.foldl1 = Data.Foldable.$dmfoldl1 @(DrvEmptyData.Void) + + + +==================== Filling in method body ==================== +Data.Foldable.Foldable [DrvEmptyData.Void] + Data.Foldable.toList = Data.Foldable.$dmtoList @(DrvEmptyData.Void) + + + +==================== Filling in method body ==================== +Data.Foldable.Foldable [DrvEmptyData.Void] + Data.Foldable.null = Data.Foldable.$dmnull @(DrvEmptyData.Void) + + + +==================== Filling in method body ==================== +Data.Foldable.Foldable [DrvEmptyData.Void] + Data.Foldable.length = Data.Foldable.$dmlength @(DrvEmptyData.Void) + + + +==================== Filling in method body ==================== +Data.Foldable.Foldable [DrvEmptyData.Void] + Data.Foldable.elem = Data.Foldable.$dmelem @(DrvEmptyData.Void) + + + +==================== Filling in method body ==================== +Data.Foldable.Foldable [DrvEmptyData.Void] + Data.Foldable.maximum = Data.Foldable.$dmmaximum + @(DrvEmptyData.Void) + + + +==================== Filling in method body ==================== +Data.Foldable.Foldable [DrvEmptyData.Void] + Data.Foldable.minimum = Data.Foldable.$dmminimum + @(DrvEmptyData.Void) + + + +==================== Filling in method body ==================== +Data.Foldable.Foldable [DrvEmptyData.Void] + Data.Foldable.sum = Data.Foldable.$dmsum @(DrvEmptyData.Void) + + + +==================== Filling in method body ==================== +Data.Foldable.Foldable [DrvEmptyData.Void] + Data.Foldable.product = Data.Foldable.$dmproduct + @(DrvEmptyData.Void) + + + +==================== Filling in method body ==================== +Data.Traversable.Traversable [DrvEmptyData.Void] + Data.Traversable.sequenceA = Data.Traversable.$dmsequenceA + @(DrvEmptyData.Void) + + + +==================== Filling in method body ==================== +Data.Traversable.Traversable [DrvEmptyData.Void] + Data.Traversable.mapM = Data.Traversable.$dmmapM + @(DrvEmptyData.Void) + + + +==================== Filling in method body ==================== +Data.Traversable.Traversable [DrvEmptyData.Void] + Data.Traversable.sequence = Data.Traversable.$dmsequence + @(DrvEmptyData.Void) + + diff --git a/testsuite/tests/deriving/should_compile/drv-functor1.hs b/testsuite/tests/deriving/should_compile/drv-functor1.hs index 8249858cae..040d531341 100644 --- a/testsuite/tests/deriving/should_compile/drv-functor1.hs +++ b/testsuite/tests/deriving/should_compile/drv-functor1.hs @@ -41,7 +41,7 @@ data Compose f g a = Compose (f (g a)) -- i.e.: -- instance (Functor (f Bool), Functor (f Int)) => Functor (ComplexConstraint f) -- This requires FlexibleContexts and UndecidableInstances -data ComplexConstraint f a = ComplexContraint (f Int (f Bool a,a)) +data ComplexConstraint f a = ComplexConstraint (f Int (f Bool a,a)) -- deriving (Functor) data Universal a diff --git a/testsuite/tests/deriving/should_fail/T10598_fail3.stderr b/testsuite/tests/deriving/should_fail/T10598_fail3.stderr index a987a4993d..c3f4e123b7 100644 --- a/testsuite/tests/deriving/should_fail/T10598_fail3.stderr +++ b/testsuite/tests/deriving/should_fail/T10598_fail3.stderr @@ -1,5 +1,4 @@ -T10598_fail3.hs:1:1: error: - Generic instances can only be derived in Safe Haskell using the stock strategy. - In the following instance: - instance [safe] Generic T +T10598_fail3.hs:8:36: error: + • Generic instances can only be derived in Safe Haskell using the stock strategy. + • In the instance declaration for ‘Generic T’ diff --git a/testsuite/tests/deriving/should_fail/T12512.hs b/testsuite/tests/deriving/should_fail/T12512.hs index 4d4e52c06c..804bfd31da 100644 --- a/testsuite/tests/deriving/should_fail/T12512.hs +++ b/testsuite/tests/deriving/should_fail/T12512.hs @@ -1,7 +1,7 @@ {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE UnboxedSums #-} {-# LANGUAGE UnboxedTuples #-} -{-# LANGUAGE TypeInType #-} +{-# LANGUAGE DataKinds, PolyKinds #-} module T12512 where import GHC.Exts diff --git a/testsuite/tests/deriving/should_fail/T12512.stderr b/testsuite/tests/deriving/should_fail/T12512.stderr index a62cda6b99..78c49f4233 100644 --- a/testsuite/tests/deriving/should_fail/T12512.stderr +++ b/testsuite/tests/deriving/should_fail/T12512.stderr @@ -1,10 +1,12 @@ T12512.hs:10:1: error: • Can't make a derived instance of ‘Wat1 (# a, b #)’: - The last argument of the instance cannot be an unboxed tuple + ‘Wat1’ is not a stock derivable class (Eq, Show, etc.) + Try enabling DeriveAnyClass • In the stand-alone deriving instance for ‘Wat1 (# a, b #)’ T12512.hs:13:1: error: • Can't make a derived instance of ‘Wat2 (# a | b #)’: - The last argument of the instance cannot be an unboxed sum + ‘Wat2’ is not a stock derivable class (Eq, Show, etc.) + Try enabling DeriveAnyClass • In the stand-alone deriving instance for ‘Wat2 (# a | b #)’ diff --git a/testsuite/tests/deriving/should_fail/T14365.stderr b/testsuite/tests/deriving/should_fail/T14365.stderr new file mode 100644 index 0000000000..f8f106fea8 --- /dev/null +++ b/testsuite/tests/deriving/should_fail/T14365.stderr @@ -0,0 +1,13 @@ +[1 of 3] Compiling T14365B[boot] ( T14365B.hs-boot, T14365B.o-boot ) + +T14365B.hs-boot:5:13: error: + • Can't make a derived instance of ‘Functor Foo’: + Cannot derive instances in hs-boot files + Write an instance declaration instead + • In the data declaration for ‘Foo’ + +T14365B.hs-boot:7:1: error: + • Can't make a derived instance of ‘Foldable Foo’: + Cannot derive instances in hs-boot files + Write an instance declaration instead + • In the stand-alone deriving instance for ‘Foldable Foo’ diff --git a/testsuite/tests/deriving/should_fail/T14365A.hs b/testsuite/tests/deriving/should_fail/T14365A.hs new file mode 100644 index 0000000000..e80e7d108a --- /dev/null +++ b/testsuite/tests/deriving/should_fail/T14365A.hs @@ -0,0 +1,5 @@ +module T14365A where + +import {-# SOURCE #-} T14365B + +main = return () diff --git a/testsuite/tests/deriving/should_fail/T14365B.hs b/testsuite/tests/deriving/should_fail/T14365B.hs new file mode 100644 index 0000000000..596c275410 --- /dev/null +++ b/testsuite/tests/deriving/should_fail/T14365B.hs @@ -0,0 +1,4 @@ +module T14365B where + +data Foo a = Foo a + deriving (Functor) diff --git a/testsuite/tests/deriving/should_fail/T14365B.hs-boot b/testsuite/tests/deriving/should_fail/T14365B.hs-boot new file mode 100644 index 0000000000..1dcbc9494c --- /dev/null +++ b/testsuite/tests/deriving/should_fail/T14365B.hs-boot @@ -0,0 +1,7 @@ +{-# LANGUAGE StandaloneDeriving #-} +module T14365B where + +data Foo a + deriving (Functor) + +deriving instance Foldable Foo diff --git a/testsuite/tests/deriving/should_fail/T14728a.hs b/testsuite/tests/deriving/should_fail/T14728a.hs new file mode 100644 index 0000000000..5c1d1689dc --- /dev/null +++ b/testsuite/tests/deriving/should_fail/T14728a.hs @@ -0,0 +1,20 @@ +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE DataKinds, PolyKinds #-} +module T14728a where + +import Data.Functor.Identity +import Data.Kind + +class C (a :: Type) where + type T a (x :: a) :: Type + type U z :: a + +instance C () where + type T () '() = Bool + +deriving instance C (Identity a) + +f :: T (Identity ()) ('Identity '()) +f = True diff --git a/testsuite/tests/deriving/should_fail/T14728a.stderr b/testsuite/tests/deriving/should_fail/T14728a.stderr new file mode 100644 index 0000000000..b76d073645 --- /dev/null +++ b/testsuite/tests/deriving/should_fail/T14728a.stderr @@ -0,0 +1,7 @@ + +T14728a.hs:17:1: error: + • Can't make a derived instance of ‘C (Identity a)’ + (even with cunning GeneralizedNewtypeDeriving): + the associated type ‘T’ contains the last type variable + of the class ‘C’ in a kind, which is not (yet) allowed + • In the stand-alone deriving instance for ‘C (Identity a)’ diff --git a/testsuite/tests/deriving/should_fail/T14728b.hs b/testsuite/tests/deriving/should_fail/T14728b.hs new file mode 100644 index 0000000000..653bcb9252 --- /dev/null +++ b/testsuite/tests/deriving/should_fail/T14728b.hs @@ -0,0 +1,16 @@ +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE DataKinds, PolyKinds #-} +module T14728b where + +import Data.Functor.Identity +import Data.Kind + +class C (a :: Type) where + type U z :: a + +instance C () where + type U z = '() + +deriving instance C (Identity a) diff --git a/testsuite/tests/deriving/should_fail/T14728b.stderr b/testsuite/tests/deriving/should_fail/T14728b.stderr new file mode 100644 index 0000000000..ee74f8b4da --- /dev/null +++ b/testsuite/tests/deriving/should_fail/T14728b.stderr @@ -0,0 +1,7 @@ + +T14728b.hs:16:1: error: + • Can't make a derived instance of ‘C (Identity a)’ + (even with cunning GeneralizedNewtypeDeriving): + the associated type ‘U’ contains the last type variable + of the class ‘C’ in a kind, which is not (yet) allowed + • In the stand-alone deriving instance for ‘C (Identity a)’ diff --git a/testsuite/tests/deriving/should_fail/T14916.hs b/testsuite/tests/deriving/should_fail/T14916.hs new file mode 100644 index 0000000000..19b323fc6d --- /dev/null +++ b/testsuite/tests/deriving/should_fail/T14916.hs @@ -0,0 +1,8 @@ +{-# LANGUAGE DeriveAnyClass #-} +module T14916 where + +import Data.Coerce +import Data.Typeable + +data A = MkA deriving ((~) A) +data B = MkB deriving (Coercible B) diff --git a/testsuite/tests/deriving/should_fail/T14916.stderr b/testsuite/tests/deriving/should_fail/T14916.stderr new file mode 100644 index 0000000000..81f94650f5 --- /dev/null +++ b/testsuite/tests/deriving/should_fail/T14916.stderr @@ -0,0 +1,8 @@ + +T14916.hs:7:24: error: + • Class ‘~’ does not support user-specified instances + • In the data declaration for ‘A’ + +T14916.hs:8:24: error: + • Class ‘Coercible’ does not support user-specified instances + • In the data declaration for ‘B’ diff --git a/testsuite/tests/deriving/should_fail/T15073.hs b/testsuite/tests/deriving/should_fail/T15073.hs new file mode 100644 index 0000000000..b1da4bb701 --- /dev/null +++ b/testsuite/tests/deriving/should_fail/T15073.hs @@ -0,0 +1,8 @@ +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE DataKinds, PolyKinds #-} +module T15073 where + +import T15073a + +newtype Foo a = MkFoo a + deriving P diff --git a/testsuite/tests/deriving/should_fail/T15073.stderr b/testsuite/tests/deriving/should_fail/T15073.stderr new file mode 100644 index 0000000000..87fd7e5225 --- /dev/null +++ b/testsuite/tests/deriving/should_fail/T15073.stderr @@ -0,0 +1,28 @@ + +T15073.hs:8:12: error: + • Illegal unboxed tuple type as function argument: (# Foo a #) + Perhaps you intended to use UnboxedTuples + • In an expression type signature: + Foo a + -> (Unit# (Foo a) :: TYPE (GHC.Types.TupleRep ((:) GHC.Types.LiftedRep ([] :: [] GHC.Types.RuntimeRep) :: [] GHC.Types.RuntimeRep))) + In the expression: + GHC.Prim.coerce + @(a + -> (Unit# a :: TYPE (GHC.Types.TupleRep ((:) GHC.Types.LiftedRep ([] :: [] GHC.Types.RuntimeRep) :: [] GHC.Types.RuntimeRep)))) + @(Foo a + -> (Unit# (Foo a) :: TYPE (GHC.Types.TupleRep ((:) GHC.Types.LiftedRep ([] :: [] GHC.Types.RuntimeRep) :: [] GHC.Types.RuntimeRep)))) + p :: + Foo a + -> (Unit# (Foo a) :: TYPE (GHC.Types.TupleRep ((:) GHC.Types.LiftedRep ([] :: [] GHC.Types.RuntimeRep) :: [] GHC.Types.RuntimeRep))) + In an equation for ‘p’: + p = GHC.Prim.coerce + @(a + -> (Unit# a :: TYPE (GHC.Types.TupleRep ((:) GHC.Types.LiftedRep ([] :: [] GHC.Types.RuntimeRep) :: [] GHC.Types.RuntimeRep)))) + @(Foo a + -> (Unit# (Foo a) :: TYPE (GHC.Types.TupleRep ((:) GHC.Types.LiftedRep ([] :: [] GHC.Types.RuntimeRep) :: [] GHC.Types.RuntimeRep)))) + p :: + Foo a + -> (Unit# (Foo a) :: TYPE (GHC.Types.TupleRep ((:) GHC.Types.LiftedRep ([] :: [] GHC.Types.RuntimeRep) :: [] GHC.Types.RuntimeRep))) + When typechecking the code for ‘p’ + in a derived instance for ‘P (Foo a)’: + To see the code I am typechecking, use -ddump-deriv diff --git a/testsuite/tests/deriving/should_fail/T15073a.hs b/testsuite/tests/deriving/should_fail/T15073a.hs new file mode 100644 index 0000000000..87e7571f50 --- /dev/null +++ b/testsuite/tests/deriving/should_fail/T15073a.hs @@ -0,0 +1,5 @@ +{-# LANGUAGE UnboxedTuples #-} +module T15073a where + +class P a where + p :: a -> (# a #) diff --git a/testsuite/tests/deriving/should_fail/T3621.stderr b/testsuite/tests/deriving/should_fail/T3621.stderr index 88004bb230..ec68e81f41 100644 --- a/testsuite/tests/deriving/should_fail/T3621.stderr +++ b/testsuite/tests/deriving/should_fail/T3621.stderr @@ -1,9 +1,15 @@ T3621.hs:24:43: error: - • No instance for (MonadState state (State s)) - arising from the 'deriving' clause of a data type declaration - Possible fix: - use a standalone 'deriving instance' declaration, - so you can specify the instance context yourself + • Couldn't match type ‘s’ with ‘state’ + arising from a functional dependency between: + constraint ‘MonadState state (State s)’ + arising from the 'deriving' clause of a data type declaration + instance ‘MonadState s1 (State s1)’ at T3621.hs:21:10-31 + ‘s’ is a rigid type variable bound by + the deriving clause for ‘MonadState state (WrappedState s)’ + at T3621.hs:24:43-58 + ‘state’ is a rigid type variable bound by + the deriving clause for ‘MonadState state (WrappedState s)’ + at T3621.hs:24:43-58 • When deriving the instance for (MonadState state (WrappedState s)) diff --git a/testsuite/tests/deriving/should_fail/T4846.stderr b/testsuite/tests/deriving/should_fail/T4846.stderr index 9642132f99..428f1a538b 100644 --- a/testsuite/tests/deriving/should_fail/T4846.stderr +++ b/testsuite/tests/deriving/should_fail/T4846.stderr @@ -3,9 +3,10 @@ T4846.hs:29:1: error: • Couldn't match type ‘Bool’ with ‘BOOL’ arising from a use of ‘GHC.Prim.coerce’ • In the expression: - GHC.Prim.coerce @(Expr Bool) @(Expr BOOL) mkExpr + GHC.Prim.coerce @(Expr Bool) @(Expr BOOL) mkExpr :: Expr BOOL In an equation for ‘mkExpr’: - mkExpr = GHC.Prim.coerce @(Expr Bool) @(Expr BOOL) mkExpr + mkExpr + = GHC.Prim.coerce @(Expr Bool) @(Expr BOOL) mkExpr :: Expr BOOL When typechecking the code for ‘mkExpr’ in a derived instance for ‘B BOOL’: To see the code I am typechecking, use -ddump-deriv diff --git a/testsuite/tests/deriving/should_fail/T7401_fail.hs b/testsuite/tests/deriving/should_fail/T7401_fail.hs new file mode 100644 index 0000000000..730223f179 --- /dev/null +++ b/testsuite/tests/deriving/should_fail/T7401_fail.hs @@ -0,0 +1,3 @@ +module T7401_fail where + +data D deriving Eq diff --git a/testsuite/tests/deriving/should_fail/T7401_fail.stderr b/testsuite/tests/deriving/should_fail/T7401_fail.stderr new file mode 100644 index 0000000000..feb841f962 --- /dev/null +++ b/testsuite/tests/deriving/should_fail/T7401_fail.stderr @@ -0,0 +1,6 @@ + +T7401_fail.hs:3:17: error: + • Can't make a derived instance of ‘Eq D’: + ‘D’ must have at least one data constructor + Use EmptyDataDeriving to enable deriving for empty data types + • In the data declaration for ‘D’ diff --git a/testsuite/tests/deriving/should_fail/T8165_fail2.stderr b/testsuite/tests/deriving/should_fail/T8165_fail2.stderr index 4c925f52a3..c0ceabf920 100644 --- a/testsuite/tests/deriving/should_fail/T8165_fail2.stderr +++ b/testsuite/tests/deriving/should_fail/T8165_fail2.stderr @@ -1,5 +1,6 @@ T8165_fail2.hs:9:12: error: - The type family application ‘T Loop’ - is no smaller than the instance head - (Use UndecidableInstances to permit this) + • The type family application ‘T Loop’ + is no smaller than the instance head ‘T Loop’ + (Use UndecidableInstances to permit this) + • In the instance declaration for ‘C Loop’ diff --git a/testsuite/tests/deriving/should_fail/T9687.stderr b/testsuite/tests/deriving/should_fail/T9687.stderr index a98f775bee..4c3dfe8255 100644 --- a/testsuite/tests/deriving/should_fail/T9687.stderr +++ b/testsuite/tests/deriving/should_fail/T9687.stderr @@ -1,5 +1,5 @@ -T9687.hs:4:1: error: +T9687.hs:4:10: error: • Class ‘Typeable’ does not support user-specified instances • In the instance declaration for ‘Typeable (a, b, c, d, e, f, g, h)’ diff --git a/testsuite/tests/deriving/should_fail/all.T b/testsuite/tests/deriving/should_fail/all.T index 5fa589f321..0cc85ea4aa 100644 --- a/testsuite/tests/deriving/should_fail/all.T +++ b/testsuite/tests/deriving/should_fail/all.T @@ -4,9 +4,9 @@ test('drvfail002', normal, compile_fail, ['']) test('drvfail003', normal, compile_fail, ['']) test('drvfail004', normal, compile_fail, ['']) test('drvfail005', normal, compile_fail, ['']) -test('drvfail006', reqlib('mtl'), compile_fail, ['']) +test('drvfail006', normal, compile_fail, ['']) test('drvfail007', normal, compile_fail, ['']) -test('drvfail008', reqlib('mtl'), compile_fail, ['']) +test('drvfail008', normal, compile_fail, ['']) test('drvfail009', normal, compile_fail, ['']) test('drvfail011', normal, compile_fail, ['']) test('drvfail012', normal, compile_fail, ['']) @@ -44,6 +44,7 @@ test('T7148a', normal, compile_fail, ['']) # T7800 was removed as it was out of date re: fixing #9858 test('T5498', normal, compile_fail, ['']) test('T6147', normal, compile_fail, ['']) +test('T7401_fail', normal, compile_fail, ['']) test('T8165_fail1', normal, compile_fail, ['']) test('T8165_fail2', normal, compile_fail, ['']) test('T8851', normal, compile_fail, ['']) @@ -66,3 +67,14 @@ test('T11509_1', [when(doing_ghci(), extra_hc_opts('-fobject-code'))], test('T12163', normal, compile_fail, ['']) test('T12512', omit_ways(['ghci']), compile_fail, ['']) test('T12801', normal, compile_fail, ['']) +test('T14365', [extra_files(['T14365B.hs','T14365B.hs-boot'])], + multimod_compile_fail, ['T14365A','']) +test('T14728a', normal, compile_fail, ['']) +test('T14728b', normal, compile_fail, ['']) +test('T14916', normal, compile_fail, ['']) +test('T15073', [extra_files(['T15073a.hs'])], multimod_compile_fail, + ['T15073', '-v0']) +test('deriving-via-fail', normal, compile_fail, ['']) +test('deriving-via-fail2', normal, compile_fail, ['']) +test('deriving-via-fail3', normal, compile_fail, ['']) +test('deriving-via-fail4', normal, compile_fail, ['']) diff --git a/testsuite/tests/deriving/should_fail/deriving-via-fail.hs b/testsuite/tests/deriving/should_fail/deriving-via-fail.hs new file mode 100644 index 0000000000..fbae1e7d13 --- /dev/null +++ b/testsuite/tests/deriving/should_fail/deriving-via-fail.hs @@ -0,0 +1,19 @@ +{-# LANGUAGE DerivingVia #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE StandaloneDeriving #-} +module DerivingViaFail where + +import Control.Category +import Data.Functor.Identity + +newtype Foo1 a = Foo1 a deriving Show via (Identity b) + +newtype Foo2 a b = Foo2 (a -> b) + deriving Category + via fooo + +data Foo3 deriving Eq via (forall a. a) + +newtype Foo4 a = Foo4 a +deriving via (Identity b) + instance Show (Foo4 a) diff --git a/testsuite/tests/deriving/should_fail/deriving-via-fail.stderr b/testsuite/tests/deriving/should_fail/deriving-via-fail.stderr new file mode 100644 index 0000000000..51907e02cf --- /dev/null +++ b/testsuite/tests/deriving/should_fail/deriving-via-fail.stderr @@ -0,0 +1,16 @@ + +deriving-via-fail.hs:9:34: error: + Type variable ‘b’ is bound in the ‘via’ type ‘(Identity b)’ + but is not mentioned in the derived class ‘Show’, which is illegal + +deriving-via-fail.hs:12:12: error: + Type variable ‘fooo’ is bound in the ‘via’ type ‘fooo’ + but is not mentioned in the derived class ‘Category’, which is illegal + +deriving-via-fail.hs:15:20: error: + Type variable ‘a’ is bound in the ‘via’ type ‘(forall a. a)’ + but is not mentioned in the derived class ‘Eq’, which is illegal + +deriving-via-fail.hs:19:12: error: + Type variable ‘b’ is bound in the ‘via’ type ‘(Identity b)’ + but is not mentioned in the derived instance ‘Show (Foo4 a)’, which is illegal diff --git a/testsuite/tests/deriving/should_fail/deriving-via-fail2.hs b/testsuite/tests/deriving/should_fail/deriving-via-fail2.hs new file mode 100644 index 0000000000..e9a456d048 --- /dev/null +++ b/testsuite/tests/deriving/should_fail/deriving-via-fail2.hs @@ -0,0 +1,7 @@ +{-# LANGUAGE DerivingVia #-} +{-# LANGUAGE StandaloneDeriving #-} +module DerivingViaFail2 where + +class C a +data A = A +deriving via Maybe instance C A diff --git a/testsuite/tests/deriving/should_fail/deriving-via-fail2.stderr b/testsuite/tests/deriving/should_fail/deriving-via-fail2.stderr new file mode 100644 index 0000000000..d5692ad6b2 --- /dev/null +++ b/testsuite/tests/deriving/should_fail/deriving-via-fail2.stderr @@ -0,0 +1,6 @@ + +deriving-via-fail2.hs:7:1: error: + • Cannot derive instance via ‘Maybe’ + Class ‘C’ expects an argument of kind ‘*’, + but ‘Maybe’ has kind ‘* -> *’ + • In the stand-alone deriving instance for ‘C A’ diff --git a/testsuite/tests/deriving/should_fail/deriving-via-fail3.hs b/testsuite/tests/deriving/should_fail/deriving-via-fail3.hs new file mode 100644 index 0000000000..ad8e0be542 --- /dev/null +++ b/testsuite/tests/deriving/should_fail/deriving-via-fail3.hs @@ -0,0 +1,3 @@ +module DerivingViaFail3 where + +data F deriving Eq via F diff --git a/testsuite/tests/deriving/should_fail/deriving-via-fail3.stderr b/testsuite/tests/deriving/should_fail/deriving-via-fail3.stderr new file mode 100644 index 0000000000..f2af73a01f --- /dev/null +++ b/testsuite/tests/deriving/should_fail/deriving-via-fail3.stderr @@ -0,0 +1,4 @@ + +deriving-via-fail3.hs:3:1: error: + Illegal deriving strategy: via + Use DerivingVia to enable this extension diff --git a/testsuite/tests/deriving/should_fail/deriving-via-fail4.hs b/testsuite/tests/deriving/should_fail/deriving-via-fail4.hs new file mode 100644 index 0000000000..1436d994c0 --- /dev/null +++ b/testsuite/tests/deriving/should_fail/deriving-via-fail4.hs @@ -0,0 +1,17 @@ +{-# LANGUAGE DerivingVia #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE ScopedTypeVariables #-} +module DerivingViaFail4 where + +class C a b where + c :: a -> b -> Bool + +instance C a a where + c _ _ = True + +newtype F1 = F1 Int + deriving Eq via Char + +newtype F2 a = MkF2 a + deriving (C a) via (forall a. a) diff --git a/testsuite/tests/deriving/should_fail/deriving-via-fail4.stderr b/testsuite/tests/deriving/should_fail/deriving-via-fail4.stderr new file mode 100644 index 0000000000..caa2bfe93b --- /dev/null +++ b/testsuite/tests/deriving/should_fail/deriving-via-fail4.stderr @@ -0,0 +1,18 @@ + +deriving-via-fail4.hs:14:12: error: + • Couldn't match representation of type ‘Int’ with that of ‘Char’ + arising from the coercion of the method ‘==’ + from type ‘Char -> Char -> Bool’ to type ‘F1 -> F1 -> Bool’ + • When deriving the instance for (Eq F1) + +deriving-via-fail4.hs:17:13: error: + • Couldn't match representation of type ‘a1’ with that of ‘a’ + arising from the coercion of the method ‘c’ + from type ‘a -> a -> Bool’ to type ‘a -> F2 a1 -> Bool’ + ‘a1’ is a rigid type variable bound by + the deriving clause for ‘C a (F2 a1)’ + at deriving-via-fail4.hs:17:13-15 + ‘a’ is a rigid type variable bound by + the deriving clause for ‘C a (F2 a1)’ + at deriving-via-fail4.hs:17:13-15 + • When deriving the instance for (C a (F2 a1)) diff --git a/testsuite/tests/deriving/should_fail/drvfail004.stderr b/testsuite/tests/deriving/should_fail/drvfail004.stderr index 1b2d63527b..d182565692 100644 --- a/testsuite/tests/deriving/should_fail/drvfail004.stderr +++ b/testsuite/tests/deriving/should_fail/drvfail004.stderr @@ -2,7 +2,7 @@ drvfail004.hs:8:12: error: • Could not deduce (Eq (Foo a b)) arising from the 'deriving' clause of a data type declaration - from the context: (Ord b, Ord a) + from the context: (Ord a, Ord b) bound by the deriving clause for ‘Ord (Foo a b)’ at drvfail004.hs:8:12-14 Possible fix: diff --git a/testsuite/tests/deriving/should_fail/drvfail016.stderr b/testsuite/tests/deriving/should_fail/drvfail016.stderr index 182b74893f..05abbf5bb9 100644 --- a/testsuite/tests/deriving/should_fail/drvfail016.stderr +++ b/testsuite/tests/deriving/should_fail/drvfail016.stderr @@ -1,4 +1,6 @@ drvfail016.hs-boot:7:14: error: - Deriving not permitted in hs-boot file - Use an instance declaration instead + • Can't make a derived instance of ‘Show D’: + Cannot derive instances in hs-boot files + Write an instance declaration instead + • In the data declaration for ‘D’ diff --git a/testsuite/tests/deriving/should_run/T14918.hs b/testsuite/tests/deriving/should_run/T14918.hs new file mode 100644 index 0000000000..2ad293724b --- /dev/null +++ b/testsuite/tests/deriving/should_run/T14918.hs @@ -0,0 +1,18 @@ +{-# LANGUAGE MagicHash #-} +module Main where + +data T a = MkT { runT :: a, (##) :: a } deriving (Read, Show) +data T# a = MkT# { runT# :: a, (###) :: a } deriving (Read, Show) + +t1, t2 :: T Int +t1 = MkT (-1) 1 +t2 = read $ show t1 + +t1#, t2# :: T# Int +t1# = MkT# (-1) 1 +t2# = read $ show t1# + +main :: IO () +main = do + print t2 + print t2# diff --git a/testsuite/tests/deriving/should_run/T14918.stdout b/testsuite/tests/deriving/should_run/T14918.stdout new file mode 100644 index 0000000000..b85e2a219e --- /dev/null +++ b/testsuite/tests/deriving/should_run/T14918.stdout @@ -0,0 +1,2 @@ +MkT {runT = -1, (##) = 1} +MkT# {runT# = -1, (###) = 1} diff --git a/testsuite/tests/deriving/should_run/T3087.hs b/testsuite/tests/deriving/should_run/T3087.hs index 9d3be0744d..1e20b9ece9 100644 --- a/testsuite/tests/deriving/should_run/T3087.hs +++ b/testsuite/tests/deriving/should_run/T3087.hs @@ -14,7 +14,7 @@ test1' = undefined `ext1Q` (\ (MyJust _) -> ()) $ MyJust () newtype Q r a = Q { unQ :: a -> r } -ext2Q :: (Data d, Typeable2 t) +ext2Q :: (Data d, Typeable t) => (d -> q) -> (forall d1 d2. (Data d1, Data d2) => t d1 d2 -> q) -> d -> q ext2Q def ext arg = diff --git a/testsuite/tests/deriving/should_run/T5628.stderr b/testsuite/tests/deriving/should_run/T5628.stderr deleted file mode 100644 index e203374673..0000000000 --- a/testsuite/tests/deriving/should_run/T5628.stderr +++ /dev/null @@ -1,3 +0,0 @@ -T5628: Void == -CallStack (from ImplicitParams): - error, called at T5628.hs:5:1 in main:Main diff --git a/testsuite/tests/dph/smvm/dph-smvm-copy.stdout b/testsuite/tests/deriving/should_run/T5628.stdout index 0ca95142bb..0ca95142bb 100644 --- a/testsuite/tests/dph/smvm/dph-smvm-copy.stdout +++ b/testsuite/tests/deriving/should_run/T5628.stdout diff --git a/testsuite/tests/deriving/should_run/T7401.hs b/testsuite/tests/deriving/should_run/T7401.hs new file mode 100644 index 0000000000..2f56df4e69 --- /dev/null +++ b/testsuite/tests/deriving/should_run/T7401.hs @@ -0,0 +1,20 @@ +{-# LANGUAGE EmptyDataDeriving #-} +module Main where + +import Data.Function + +data Foo + deriving (Eq, Ord, Read, Show) + +foo1 :: Foo +foo1 = fix id + +foo2 :: Foo +foo2 = let x = y + y = x + in y + +main :: IO () +main = do + print (foo1 == foo2) + print (foo1 `compare` foo2) diff --git a/testsuite/tests/deriving/should_run/T7401.stdout b/testsuite/tests/deriving/should_run/T7401.stdout new file mode 100644 index 0000000000..886c3aedac --- /dev/null +++ b/testsuite/tests/deriving/should_run/T7401.stdout @@ -0,0 +1,2 @@ +True +EQ diff --git a/testsuite/tests/deriving/should_run/all.T b/testsuite/tests/deriving/should_run/all.T index 3bcebdf371..cf0cb922ed 100644 --- a/testsuite/tests/deriving/should_run/all.T +++ b/testsuite/tests/deriving/should_run/all.T @@ -32,8 +32,9 @@ test('drvrun-foldable1', normal, compile_and_run, ['']) test('T4136', normal, compile_and_run, ['']) test('T4528a', normal, compile_and_run, ['']) test('T5041', normal, compile_and_run, ['']) -test('T5628', exit_code(1), compile_and_run, ['']) +test('T5628', normal, compile_and_run, ['']) test('T5712', normal, compile_and_run, ['']) +test('T7401', normal, compile_and_run, ['']) test('T7931', normal, compile_and_run, ['']) # T8280 is superseded by T10104 test('T9576', exit_code(1), compile_and_run, ['']) @@ -44,3 +45,4 @@ test('T10598_bug', normal, compile_and_run, ['']) test('T10598_run', normal, compile_and_run, ['']) test('T11535', when(opsys('mingw32'), expect_broken_for(12210, ['ghci'])), compile_and_run, ['']) +test('T14918', normal, compile_and_run, ['']) diff --git a/testsuite/tests/determinism/determ004/determ004.hs b/testsuite/tests/determinism/determ004/determ004.hs index 756075031d..1361d76a0e 100644 --- a/testsuite/tests/determinism/determ004/determ004.hs +++ b/testsuite/tests/determinism/determ004/determ004.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE TypeOperators +{-# LANGUAGE TypeOperators, StarIsType , DataKinds , PolyKinds , TypeFamilies diff --git a/testsuite/tests/determinism/determ014/A.hs b/testsuite/tests/determinism/determ014/A.hs index fb7a538ebd..35ea20f225 100644 --- a/testsuite/tests/determinism/determ014/A.hs +++ b/testsuite/tests/determinism/determ014/A.hs @@ -11,6 +11,8 @@ module KeyValue where +import Data.Kind + data AccValidation err a = AccFailure err | AccSuccess a data KeyValueError = MissingValue @@ -23,11 +25,11 @@ missing = rpure missingField missingField :: forall x. (WithKeyValueError :. f) x missingField = Compose $ AccFailure [MissingValue] -data Rec :: (u -> *) -> [u] -> * where +data Rec :: (u -> Type) -> [u] -> Type where RNil :: Rec f '[] (:&) :: !(f r) -> !(Rec f rs) -> Rec f (r ': rs) -newtype Compose (f :: l -> *) (g :: k -> l) (x :: k) +newtype Compose (f :: l -> Type) (g :: k -> l) (x :: k) = Compose { getCompose :: f (g x) } type (:.) f g = Compose f g diff --git a/testsuite/tests/determinism/determ017/A.hs b/testsuite/tests/determinism/determ017/A.hs index 2540be4b29..5e3c3d0809 100644 --- a/testsuite/tests/determinism/determ017/A.hs +++ b/testsuite/tests/determinism/determ017/A.hs @@ -20,7 +20,7 @@ -- | Module "Trampoline" defines the pipe computations and their basic building blocks. {-# LANGUAGE ScopedTypeVariables, Rank2Types, MultiParamTypeClasses, - TypeFamilies, KindSignatures, FlexibleContexts, + TypeFamilies, KindSignatures, FlexibleContexts, NoMonadFailDesugaring, FlexibleInstances, OverlappingInstances, UndecidableInstances #-} diff --git a/testsuite/tests/determinism/determ021/determ021.stdout b/testsuite/tests/determinism/determ021/determ021.stdout index 93cd3af04d..1f6a636ade 100644 --- a/testsuite/tests/determinism/determ021/determ021.stdout +++ b/testsuite/tests/determinism/determ021/determ021.stdout @@ -2,21 +2,21 @@ TYPE SIGNATURES test2 :: forall (f :: * -> *) t b. - (Num b, Num t, Applicative f) => + (Applicative f, Num t, Num b) => (t -> f b) -> f b TYPE CONSTRUCTORS COERCION AXIOMS Dependent modules: [] -Dependent packages: [base-4.10.0.0, ghc-prim-0.5.1.0, - integer-gmp-1.0.1.0] +Dependent packages: [base-4.12.0.0, ghc-prim-0.5.3, + integer-gmp-1.0.2.0] [1 of 1] Compiling A ( A.hs, A.o ) TYPE SIGNATURES test2 :: forall (f :: * -> *) t b. - (Num b, Num t, Applicative f) => + (Applicative f, Num t, Num b) => (t -> f b) -> f b TYPE CONSTRUCTORS COERCION AXIOMS Dependent modules: [] -Dependent packages: [base-4.10.0.0, ghc-prim-0.5.1.0, - integer-gmp-1.0.1.0] +Dependent packages: [base-4.12.0.0, ghc-prim-0.5.3, + integer-gmp-1.0.2.0] diff --git a/testsuite/tests/dph/classes/DefsVect.hs b/testsuite/tests/dph/classes/DefsVect.hs deleted file mode 100644 index f6ed5544e2..0000000000 --- a/testsuite/tests/dph/classes/DefsVect.hs +++ /dev/null @@ -1,53 +0,0 @@ -{-# LANGUAGE ParallelArrays #-} -{-# OPTIONS_GHC -fvectorise #-} - -module DefsVect where - -import Data.Array.Parallel - - --- {-# VECTORISE SCALAR instance Eq Char #-} --- {-# VECTORISE SCALAR instance Eq Float #-} --- {-# VECTORISE SCALAR instance Ord Char #-} --- {-# VECTORISE SCALAR instance Ord Float #-} - - -data MyBool = MyTrue | MyFalse - -class Eq a => Cmp a where - cmp :: a -> a -> Bool - --- FIXME: --- instance Cmp Int where --- cmp = (==) - --- isFive :: (Eq a, Num a) => a -> Bool -isFive :: Int -> Bool -isFive x = x == 5 - -isEq :: Eq a => a -> Bool -isEq x = x == x - -fiveEq :: Int -> Bool -fiveEq x = isFive x && isEq x - -cmpArrs :: PArray Int -> PArray Int -> Bool -{-# NOINLINE cmpArrs #-} -cmpArrs v w = cmpArrs' (fromPArrayP v) (fromPArrayP w) - -cmpArrs' :: [:Int:] -> [:Int:] -> Bool -cmpArrs' xs ys = andP [:x == y | x <- xs | y <- ys:] - -isFives :: PArray Int -> Bool -{-# NOINLINE isFives #-} -isFives xs = isFives' (fromPArrayP xs) - -isFives' :: [:Int:] -> Bool -isFives' xs = andP (mapP isFive xs) - -isEqs :: PArray Int -> Bool -{-# NOINLINE isEqs #-} -isEqs xs = isEqs' (fromPArrayP xs) - -isEqs' :: [:Int:] -> Bool -isEqs' xs = andP (mapP isEq xs) diff --git a/testsuite/tests/dph/classes/Main.hs b/testsuite/tests/dph/classes/Main.hs deleted file mode 100644 index 471c0cc8e0..0000000000 --- a/testsuite/tests/dph/classes/Main.hs +++ /dev/null @@ -1,15 +0,0 @@ -module Main where - -import Data.Array.Parallel.PArray (PArray, fromList) - -import DefsVect - -main - = let v = fromList [1..10] - w = fromList [11..20] - in - print $ [ fiveEq 5 - , cmpArrs v w - , isFives (fromList $ replicate 10 5) - , isEqs v - ] diff --git a/testsuite/tests/dph/classes/dph-classes-copy-fast.stdout b/testsuite/tests/dph/classes/dph-classes-copy-fast.stdout deleted file mode 100644 index bf8e7b9e4b..0000000000 --- a/testsuite/tests/dph/classes/dph-classes-copy-fast.stdout +++ /dev/null @@ -1 +0,0 @@ -[True,False,True,True] diff --git a/testsuite/tests/dph/classes/dph-classes-vseg-fast.stdout b/testsuite/tests/dph/classes/dph-classes-vseg-fast.stdout deleted file mode 100644 index bf8e7b9e4b..0000000000 --- a/testsuite/tests/dph/classes/dph-classes-vseg-fast.stdout +++ /dev/null @@ -1 +0,0 @@ -[True,False,True,True] diff --git a/testsuite/tests/dph/classes/dph-classes.T b/testsuite/tests/dph/classes/dph-classes.T deleted file mode 100644 index acd19ba4b1..0000000000 --- a/testsuite/tests/dph/classes/dph-classes.T +++ /dev/null @@ -1,6 +0,0 @@ - -test('dph-classes-vseg-fast', - [normal, reqlib('dph-lifted-vseg'), reqlib('dph-prim-par'), - only_ways(['normal', 'threaded1', 'threaded2'])], - multimod_compile_and_run, - ['Main', '-O0 -fno-enable-rewrite-rules -package dph-lifted-vseg']) diff --git a/testsuite/tests/dph/diophantine/DiophantineVect.hs b/testsuite/tests/dph/diophantine/DiophantineVect.hs deleted file mode 100644 index 981b9ad62d..0000000000 --- a/testsuite/tests/dph/diophantine/DiophantineVect.hs +++ /dev/null @@ -1,39 +0,0 @@ -{-# LANGUAGE ParallelArrays #-} -{-# OPTIONS -fvectorise -XParallelListComp #-} -module DiophantineVect (solution3) where - -import Data.Array.Parallel -import Data.Array.Parallel.Prelude.Int as I - -import qualified Prelude as P - -solution3' - = let - pow x i = productP (replicateP i x) - primes = [: 2,3,5,7,11,13,17,19,23,29,31,37,41,43,47,53,59,61,67,71,73 :] - a `cutTo` b = sliceP 0 (lengthP b) a - sumpri xx = productP [: pow p x | p <- primes `cutTo` xx | x <- xx :] - distinct xx = productP [: x I.+ 1 | x <- xx :] - - series :: [:Int:] -> Int -> [:[:Int:]:] - series xs n - | n == 1 = [: [: 0 :] :] - | otherwise = [: [: x :] +:+ ps - | x <- xs - , ps <- series (I.enumFromToP 0 x) (n I.- 1) :] - - prob x y - = let xx = [: (sumpri m ,m) - | m <- series (I.enumFromToP 1 3) x - , distinct [: x I.* 2 | x <- m :] > y :] - i = minIndexP [: a | (a, b) <- xx :] - in xx !: i - in - prob 5 200 - -solution3 :: (Int, PArray Int) -{-# NOINLINE solution3 #-} -solution3 - = let (i, is) = solution3' - in - (i, toPArrayP is) diff --git a/testsuite/tests/dph/diophantine/Main.hs b/testsuite/tests/dph/diophantine/Main.hs deleted file mode 100644 index 571566ebcb..0000000000 --- a/testsuite/tests/dph/diophantine/Main.hs +++ /dev/null @@ -1,42 +0,0 @@ -{-# LANGUAGE ParallelArrays #-} - -import Data.List -import DiophantineVect - -import qualified Data.Array.Parallel.PArray as P -import Data.Array.Parallel.Prelude - - --- Solution for the 108th Euler problem. --- From the Haskell Wiki -solution1 - = let primes = [2,3,5,7,11,13,17,19,23,29,31,37,41,43,47,53,59,61,67,71,73] - series _ 1 = [[0]] - series xs n = [x:ps | x <- xs, ps <- series [0..x] (n-1) ] - distinct = product . map (+1) - sumpri x = product $ zipWith (^) primes x - - prob x y = minimum [ (sumpri m ,m) - | m <- series [1..3] x - , (>y) $ distinct $ map (*2) m] - in prob 5 200 - -solution2 - = let primes = [2,3,5,7,11,13,17,19,23,29,31,37,41,43,47,53,59,61,67,71,73] - series _ 1 = [[0]] - series xs n = [x:ps | x <- xs, ps <- series [0..x] (n-1) ] - distinct xx = product [ x + 1 | x <- xx ] - sumpri xx = product $ zipWith (^) primes xx - - prob x y = minimum [ (sumpri m ,m) - | m <- series [1..3] x - , (distinct $ map (*2) m) > y ] - in prob 5 200 - - -main - = do print solution1 - print solution2 - print solution3 - - diff --git a/testsuite/tests/dph/diophantine/dph-diophantine-copy-fast.stdout b/testsuite/tests/dph/diophantine/dph-diophantine-copy-fast.stdout deleted file mode 100644 index 3fe0f66bd1..0000000000 --- a/testsuite/tests/dph/diophantine/dph-diophantine-copy-fast.stdout +++ /dev/null @@ -1,3 +0,0 @@ -(1260,[2,2,1,1,0]) -(1260,[2,2,1,1,0]) -(1260,fromList<PArray> [2,2,1,1,0]) diff --git a/testsuite/tests/dph/diophantine/dph-diophantine-copy-opt.stdout b/testsuite/tests/dph/diophantine/dph-diophantine-copy-opt.stdout deleted file mode 100644 index 3fe0f66bd1..0000000000 --- a/testsuite/tests/dph/diophantine/dph-diophantine-copy-opt.stdout +++ /dev/null @@ -1,3 +0,0 @@ -(1260,[2,2,1,1,0]) -(1260,[2,2,1,1,0]) -(1260,fromList<PArray> [2,2,1,1,0]) diff --git a/testsuite/tests/dph/diophantine/dph-diophantine.T b/testsuite/tests/dph/diophantine/dph-diophantine.T deleted file mode 100644 index fbcf565145..0000000000 --- a/testsuite/tests/dph/diophantine/dph-diophantine.T +++ /dev/null @@ -1,11 +0,0 @@ - - -test ('dph-diophantine-copy-fast' - , [ outputdir('fast') - , reqlib('dph-lifted-copy') - , reqlib('dph-prim-par') - , only_ways(['normal', 'threaded1', 'threaded2']) ] - , multimod_compile_and_run - , [ 'Main' - , '-O0 -package dph-lifted-copy']) - diff --git a/testsuite/tests/dph/dotp/DotPVect.hs b/testsuite/tests/dph/dotp/DotPVect.hs deleted file mode 100644 index 3fc9084245..0000000000 --- a/testsuite/tests/dph/dotp/DotPVect.hs +++ /dev/null @@ -1,15 +0,0 @@ -{-# LANGUAGE ParallelArrays #-} -{-# OPTIONS -fvectorise #-} -module DotPVect ( dotp ) where - -import Data.Array.Parallel -import Data.Array.Parallel.Prelude.Double as D - -import qualified Prelude - -dotp :: PArray Double -> PArray Double -> Double -{-# NOINLINE dotp #-} -dotp v w = dotp' (fromPArrayP v) (fromPArrayP w) - -dotp' :: [:Double:] -> [:Double:] -> Double -dotp' v w = D.sumP (zipWithP (D.*) v w) diff --git a/testsuite/tests/dph/dotp/Main.hs b/testsuite/tests/dph/dotp/Main.hs deleted file mode 100644 index 04eb407fc7..0000000000 --- a/testsuite/tests/dph/dotp/Main.hs +++ /dev/null @@ -1,54 +0,0 @@ -import DotPVect ( dotp ) - -import Control.Exception (evaluate) -import System.Console.GetOpt -import qualified System.Random as R - -import qualified Data.Array.Parallel.Unlifted as U -import qualified Data.Array.Parallel.PArray as P -import Data.Array.Parallel.PArray (PArray) - - - -generateVectorU :: Int -> IO (U.Array Double) -generateVectorU n = - do - let seed = 42742 - let rg = R.mkStdGen seed - let -- The std random function is too slow to generate really big vectors - -- with. Instead, we generate a short random vector and repeat that. - randvec = U.randomRs k (-100, 100) rg - vec = U.map (\i -> U.index "generateVectorU" randvec (i `mod` k)) (U.enumFromTo 0 (n-1)) - evaluate vec - return vec - where - k = 1000 - -generateVector :: Int -> IO (PArray Double) -generateVector n - = do - vec <- generateVectorU n - return $ P.fromUArray vec - -generateVectors :: Int -> IO (PArray Double, PArray Double) -generateVectors n = - do - v <- generateVector n - w <- generateVector n - return (v,w) - -main - = do -- compute dot product with NDP - vectors <- generateVectors 100000 - let resultViaNDP = (uncurry dotp) vectors - - -- compute with lists - let (aVecX, aVecY) = vectors - let vecX = P.toList aVecX - let vecY = P.toList aVecY - let resultViaList = sum $ zipWith (*) vecX vecY - - -- ignore wibbles in low order bits - putStr $ (take 12 $ show resultViaNDP) ++ "\n" - putStr $ (take 12 $ show resultViaList) ++ "\n" - diff --git a/testsuite/tests/dph/dotp/dph-dotp-copy-fast.stdout b/testsuite/tests/dph/dotp/dph-dotp-copy-fast.stdout deleted file mode 100644 index e8f012cbc6..0000000000 --- a/testsuite/tests/dph/dotp/dph-dotp-copy-fast.stdout +++ /dev/null @@ -1,2 +0,0 @@ -3.3659625259 -3.3659625259 diff --git a/testsuite/tests/dph/dotp/dph-dotp-copy-opt.stdout b/testsuite/tests/dph/dotp/dph-dotp-copy-opt.stdout deleted file mode 100644 index e8f012cbc6..0000000000 --- a/testsuite/tests/dph/dotp/dph-dotp-copy-opt.stdout +++ /dev/null @@ -1,2 +0,0 @@ -3.3659625259 -3.3659625259 diff --git a/testsuite/tests/dph/dotp/dph-dotp-vseg-fast.stdout b/testsuite/tests/dph/dotp/dph-dotp-vseg-fast.stdout deleted file mode 100644 index e8f012cbc6..0000000000 --- a/testsuite/tests/dph/dotp/dph-dotp-vseg-fast.stdout +++ /dev/null @@ -1,2 +0,0 @@ -3.3659625259 -3.3659625259 diff --git a/testsuite/tests/dph/dotp/dph-dotp-vseg-opt.stdout b/testsuite/tests/dph/dotp/dph-dotp-vseg-opt.stdout deleted file mode 100644 index e8f012cbc6..0000000000 --- a/testsuite/tests/dph/dotp/dph-dotp-vseg-opt.stdout +++ /dev/null @@ -1,2 +0,0 @@ -3.3659625259 -3.3659625259 diff --git a/testsuite/tests/dph/dotp/dph-dotp.T b/testsuite/tests/dph/dotp/dph-dotp.T deleted file mode 100644 index e49644290a..0000000000 --- a/testsuite/tests/dph/dotp/dph-dotp.T +++ /dev/null @@ -1,20 +0,0 @@ - - -test ('dph-dotp-copy-fast' - , [ outputdir('copy-fast') - , reqlib('dph-lifted-copy') - , reqlib('dph-prim-par') - , only_ways(['normal', 'threaded1', 'threaded2']) ] - , multimod_compile_and_run - , [ 'Main' - , '-O0 -package dph-lifted-copy -package dph-prim-par']) - -test ('dph-dotp-vseg-fast' - , [ outputdir('vseg-fast') - , reqlib('dph-lifted-vseg') - , reqlib('dph-prim-par') - , only_ways(['normal', 'threaded1', 'threaded2']) ] - , multimod_compile_and_run - , [ 'Main' - , '-O0 -package dph-lifted-vseg -package dph-prim-par']) - diff --git a/testsuite/tests/dph/enumfromto/EnumFromToP.hs b/testsuite/tests/dph/enumfromto/EnumFromToP.hs deleted file mode 100644 index f210f21dab..0000000000 --- a/testsuite/tests/dph/enumfromto/EnumFromToP.hs +++ /dev/null @@ -1,24 +0,0 @@ --- List enumeration doesn't work for parallel list comprehensions. --- --- > ghc-stage2: panic! (the 'impossible' happened) --- > (GHC version 7.7.20130109 for x86_64-unknown-linux): --- > DsMonad: uninitialised ds_parr_bi --- --- (I.enumFromToP is a workaround) - -{-# LANGUAGE ParallelArrays, ParallelListComp #-} -{-# OPTIONS -fvectorise #-} -module EnumFromToP where - -import Data.Array.Parallel hiding ((+), (-), (*), (/)) -import Data.Array.Parallel.PArray -import Data.Array.Parallel.Prelude.Bool as B -import Data.Array.Parallel.Prelude.Double as D -import qualified Data.Array.Parallel.Prelude.Int as I -import qualified Data.Vector as V -import qualified Prelude as P - - -nums = [: 0 .. 100 :] - - diff --git a/testsuite/tests/dph/enumfromto/dph-enumfromto.T b/testsuite/tests/dph/enumfromto/dph-enumfromto.T deleted file mode 100644 index ac4d0f0176..0000000000 --- a/testsuite/tests/dph/enumfromto/dph-enumfromto.T +++ /dev/null @@ -1,4 +0,0 @@ -test('EnumFromToP', - [reqlib('dph-lifted-vseg'), reqlib('dph-prim-par'), expect_broken(7736), - only_ways(['normal', 'threaded1', 'threaded2'])], - compile, ['-O0 -package dph-lifted-vseg']) diff --git a/testsuite/tests/dph/modules/ExportList.hs b/testsuite/tests/dph/modules/ExportList.hs deleted file mode 100644 index 99011e1a97..0000000000 --- a/testsuite/tests/dph/modules/ExportList.hs +++ /dev/null @@ -1,33 +0,0 @@ --- Explicit export list --- Produces error --- > ghc-stage2: panic! (the 'impossible' happened) --- > (GHC version 7.7.20130109 for x86_64-unknown-linux): --- > nameModule solveV{v r3Ep} --- It is something about internal vs external names. - -{-# LANGUAGE ParallelArrays, ParallelListComp #-} -{-# OPTIONS -fvectorise #-} -module ExportList (solvePA) where - -import Data.Array.Parallel hiding ((+), (-), (*), (/)) -import Data.Array.Parallel.PArray -import Data.Array.Parallel.Prelude.Bool as B -import Data.Array.Parallel.Prelude.Double as D -import qualified Data.Array.Parallel.Prelude.Int as I -import qualified Data.Vector as V -import qualified Prelude as P - -data NodeV = NodeV Double Double Double [:NodeV:] - -{-# NOINLINE solvePA #-} -solvePA - :: NodeV -- ^ nodes - -> Double -- ^ time - -> PArray Double -solvePA nodes t = toPArrayP (solveV t) - - -solveV :: Double -> [:Double:] -solveV t - = concatP (mapP solveV [: :]) - diff --git a/testsuite/tests/dph/modules/Makefile b/testsuite/tests/dph/modules/Makefile deleted file mode 100644 index 9101fbd40a..0000000000 --- a/testsuite/tests/dph/modules/Makefile +++ /dev/null @@ -1,3 +0,0 @@ -TOP=../../.. -include $(TOP)/mk/boilerplate.mk -include $(TOP)/mk/test.mk diff --git a/testsuite/tests/dph/modules/dph-ExportList-vseg-fast.stderr b/testsuite/tests/dph/modules/dph-ExportList-vseg-fast.stderr deleted file mode 100644 index bf6f453f71..0000000000 --- a/testsuite/tests/dph/modules/dph-ExportList-vseg-fast.stderr +++ /dev/null @@ -1,9 +0,0 @@ -[1 of 1] Compiling ExportList ( ExportList.hs, ExportList.o ) -Warning: vectorisation failure: identityConvTyCon: type constructor contains parallel arrays [::] - Could NOT call vectorised from original version - ExportList.solveV :: GHC.Types.Double -> [:GHC.Types.Double:] -Warning: vectorisation failure: identityConvTyCon: type constructor contains parallel arrays NodeV - Could NOT call vectorised from original version - ExportList.solvePA :: ExportList.NodeV - -> GHC.Types.Double - -> Data.Array.Parallel.PArray.PData.Base.PArray GHC.Types.Double diff --git a/testsuite/tests/dph/modules/dph-modules.T b/testsuite/tests/dph/modules/dph-modules.T deleted file mode 100644 index 6ccac11f30..0000000000 --- a/testsuite/tests/dph/modules/dph-modules.T +++ /dev/null @@ -1,4 +0,0 @@ -test('dph-ExportList-vseg-fast', - [reqlib('dph-lifted-vseg'), reqlib('dph-prim-par'), - only_ways(['normal', 'threaded1', 'threaded2'])], - multimod_compile, ['ExportList', '-O0 -package dph-lifted-vseg']) diff --git a/testsuite/tests/dph/nbody/Body.hs b/testsuite/tests/dph/nbody/Body.hs deleted file mode 100644 index 8a116993a8..0000000000 --- a/testsuite/tests/dph/nbody/Body.hs +++ /dev/null @@ -1,85 +0,0 @@ -{-# LANGUAGE BangPatterns #-} - --- | Massful bodies in the simulation. -module Body - ( Velocity - , Accel - , MassPoint - , Body - - , unitBody - , massPointOfBody - , setMassOfBody - , setAccelOfBody - , setStartVelOfBody - , advanceBody) -where -import Util - - --- Types ---------------------------------------------------------------------- --- We're using tuples instead of ADTs so we can put them in unboxed vectors. - --- | The velocity of a point. -type Velocity = (Double, Double) - --- | The acceleration of a point. -type Accel = (Double, Double) - --- | A point in 2D space with its mass. -type MassPoint = (Double, Double, Double) - --- | Bodies consist of a MassPoint, but also carry their velocity --- and acceleration between steps of the simulation. -type Body = (MassPoint, Velocity, Accel) - - --- Body ----------------------------------------------------------------------- --- | Make a body with unit mass and zero vel and acc. -unitBody :: Double -> Double -> Body -unitBody x y - = ((x, y, 1), (0, 0), (0, 0)) - - --- | Take the MassPoint of a body. -massPointOfBody :: Body -> MassPoint -massPointOfBody (mp, vel, acc) - = mp - - --- | Set the mass of a body. -setMassOfBody :: Double -> Body -> Body -setMassOfBody mass ((x, y, _), vel, acc) - = ((x, y, mass), vel, acc) - - --- | Set the acceleration of a body. -setAccelOfBody :: Accel -> Body -> Body -setAccelOfBody acc' (mp, vel, _) - = (mp, vel, acc') - - --- | Set the starting velocity of a body. --- It is set to rotate around the origin, with the speed proportional --- to the sqrt of the distance from it. This seems to make nice simulations. -setStartVelOfBody :: Double -> Body -> Body -setStartVelOfBody startVel (mp@(x, y, mass), vel, acc) - = let pos = (x, y) - (x', y') = normaliseV (x, y) - vel' = (y', -x') - vel'' = mulSV (sqrt (magV pos) * startVel) vel' - - in (mp, vel'', acc) - - --- | Advance a body forwards in time. -advanceBody :: Double -> Body -> Body -advanceBody time - ( (px, py, mass) - , (vx, vy) - , acc@(ax, ay)) - - = ( (px + time * vx, py + time * vy, mass) - , (vx + time * ax, vy + time * ay) - , acc) - diff --git a/testsuite/tests/dph/nbody/Config.hs b/testsuite/tests/dph/nbody/Config.hs deleted file mode 100644 index 1fc93a8164..0000000000 --- a/testsuite/tests/dph/nbody/Config.hs +++ /dev/null @@ -1,50 +0,0 @@ - -module Config - ( Config(..) - , defaultConfig) -where - --- | Program config -data Config - = Config { - -- What solver to use - configSolverName :: String - - -- System setup - , configBodyCount :: Int - , configBodyMass :: Double - , configTimeStep :: Double - , configEpsilon :: Double - - -- Initial conditions. - , configStartDiscSize :: Double - , configStartSpeed :: Double - - -- Terminating conditions. - , configMaxSteps :: Int - - -- Dump points to file - , configDumpFinal :: Maybe FilePath - - -- Print points to stdout - , configPrintFinal :: Bool - - -- Print timings to stdout - , configPrintTimings :: Bool } - - -defaultConfig :: Config -defaultConfig - = Config - { configSolverName = "nested-bh" - , configBodyCount = 100 - , configBodyMass = 10 - , configTimeStep = 1 - , configEpsilon = 100 - , configStartDiscSize = 50 - , configStartSpeed = 0.5 - , configMaxSteps = 10 - , configDumpFinal = Nothing - , configPrintFinal = True - , configPrintTimings = False } - diff --git a/testsuite/tests/dph/nbody/Dump.hs b/testsuite/tests/dph/nbody/Dump.hs deleted file mode 100644 index b436e3c07a..0000000000 --- a/testsuite/tests/dph/nbody/Dump.hs +++ /dev/null @@ -1,46 +0,0 @@ -{-# LANGUAGE ScopedTypeVariables #-} -module Dump - ( dumpWorld - , printWorld) -where -import Body -import World -import System.IO -import Data.List -import Text.Printf -import qualified Data.Vector.Unboxed as V - - --- | Dump the bodies in a world to a file. -dumpWorld :: World -> FilePath -> IO () -dumpWorld world filePath - = do h <- openFile filePath WriteMode - mapM_ (hWriteBody h) - $ V.toList - $ worldBodies world - hClose h - - --- | Print the bodies in a world to stdout -printWorld :: World -> IO () -printWorld world - = do mapM_ (hWriteBody stdout) - $ V.toList - $ worldBodies world - - --- | Write a single body to a file. -hWriteBody :: Handle -> Body -> IO () -hWriteBody h ((px, py, mass), (vx, vy), (ax, ay)) - = hPutStrLn h - $ concat - $ ( (padRc 8 ' ' $ show mass) - : " " - : (intersperse " " - $ map (\f -> printf "%15.8f" f) [ px, py, vx, vy, ax, ay ])) - - --- | Right justify a doc, padding with a given character. -padRc :: Int -> Char -> String -> String -padRc n c str - = replicate (n - length str) c ++ str diff --git a/testsuite/tests/dph/nbody/Generate.hs b/testsuite/tests/dph/nbody/Generate.hs deleted file mode 100644 index 808ab8e6bf..0000000000 --- a/testsuite/tests/dph/nbody/Generate.hs +++ /dev/null @@ -1,98 +0,0 @@ -{-# LANGUAGE TypeOperators #-} -module Generate - ( genPointsUniform - , genPointsUniformWithSeed - , genPointsDisc - , genPointsCombo - , pointsPArrayOfUArray ) -where -import Types -import Randomish -import qualified Data.Array.Parallel.Unlifted as U -import qualified Data.Array.Parallel as P -import qualified Data.Array.Parallel.PArray as P -import Data.Array.Parallel.PArray (PArray) -import Control.Exception - --- Random points generation --- IMPORTANT: We use the same seed with the same random generator in all --- quickhull codes. The asymptotic work complexity of quickhull --- is between O (N) and O (N^2) depending on the input. --- To compare benchmark results, they always need to use the same --- input. -seed :: Int -seed = 42742 - --- | Some uniformly distributed points -genPointsUniform - :: Int -- ^ number of points - -> Double -- ^ minimum coordinate - -> Double -- ^ maximum coordinate - -> U.Array (Double, Double) - -genPointsUniform n pointMin pointMax - = let pts = randomishDoubles (n*2) pointMin pointMax seed - xs = U.extract pts 0 n - ys = U.extract pts n n - in U.zip xs ys - - --- | Some uniformly distributed points -genPointsUniformWithSeed - :: Int -- ^ seed - -> Int -- ^ number of points - -> Double -- ^ minimum coordinate - -> Double -- ^ maximum coordinate - -> U.Array (Double, Double) - -genPointsUniformWithSeed seed' n pointMin pointMax - = let pts = randomishDoubles (n*2) pointMin pointMax seed' - xs = U.extract pts 0 n - ys = U.extract pts n n - in U.zip xs ys - - --- | Some points distributed as a disc -genPointsDisc - :: Int -- ^ number of points - -> (Double, Double) -- ^ center of disc - -> Double -- ^ radius of disc - -> U.Array (Double, Double) - -genPointsDisc n (originX, originY) radiusMax - = let radius = randomishDoubles n 0 radiusMax seed - angle = randomishDoubles n (-pi) pi (seed + 1234) - - makeXY r a - = ( originX + r * cos a - , originY + r * sin a) - - in originX `seq` originY `seq` U.zipWith makeXY radius angle - - --- | A point cloud with areas of high an low density -genPointsCombo - :: Int -- ^ number of points - -> U.Array (Double, Double) - -genPointsCombo n - = genPointsDisc (n `div` 5) (250, 250) 200 - U.+:+ genPointsDisc (n `div` 5) (100, 100) 80 - U.+:+ genPointsDisc (n `div` 5) (150, 300) 30 - U.+:+ genPointsDisc (n `div` 5) (500, 120) 30 - U.+:+ genPointsDisc (n `div` 5) (300, 200) 150 - - --- | Convert a list of points to a PArray -pointsPArrayOfUArray - :: U.Array (Double, Double) - -> IO (PArray Point) - -pointsPArrayOfUArray ps - = do - let pts = makePointsPA - (P.fromUArray (U.fsts ps)) - (P.fromUArray (U.snds ps)) - evaluate $ P.nf pts - return pts - diff --git a/testsuite/tests/dph/nbody/Main.hs b/testsuite/tests/dph/nbody/Main.hs deleted file mode 100644 index ad2c809a1c..0000000000 --- a/testsuite/tests/dph/nbody/Main.hs +++ /dev/null @@ -1,103 +0,0 @@ -{-# LANGUAGE ParallelListComp, BangPatterns #-} - -import Config -import Dump -import World -import Body -import Util -import Solver -import Generate -import Control.Monad -import Data.Maybe -import qualified Data.Vector.Unboxed as V -import qualified Data.Array.Parallel as P -import qualified Data.Array.Parallel.PArray as P - - -main :: IO () -main - = let config = defaultConfig - calcAccels = calcAccels_nb - - -- Setup initial world - vPoints = genPointsDisc - (configBodyCount config) - (0, 0) - (configStartDiscSize config) - - vBodies = V.map (setStartVelOfBody $ configStartSpeed config) - $ V.map (setMassOfBody $ configBodyMass config) - $ V.map (uncurry unitBody) - $ vPoints - - worldStart = World - { worldBodies = vBodies - , worldSteps = 0 } - - in mainBatch config calcAccels worldStart - - --- | Run the simulation in batch mode. -mainBatch :: Config -> Solver -> World -> IO () -mainBatch config calcAccels worldStart - = do let world' = mainBatchRun config calcAccels worldStart - mainEnd (configDumpFinal config) - (configPrintFinal config) - world' - - -mainBatchRun config calcAccels worldStart - = go worldStart - where go !world - = let world' = advanceWorld - (calcAccels $ configEpsilon config) - (configTimeStep config) - world - - in if worldSteps world' < configMaxSteps config - then go world' - else world' - - --- | Called at end of run to dump final world state. -mainEnd :: Maybe FilePath -- ^ Write final bodies to this file. - -> Bool -- ^ Print final bodies to stdout - -> World -- ^ Final world state. - -> IO () - -mainEnd mDumpFinal printFinal world - = do -- Dump the final world state to file if requested. - maybe (return ()) (dumpWorld world) mDumpFinal - when printFinal (printWorld world) - - --- Solver --------------------------------------------------------------------- -type Solver = Double -> V.Vector MassPoint -> V.Vector Accel - --- | Nested Data Parallelism + Barnes-Hut algorithm. -calcAccels_nb :: Solver -calcAccels_nb epsilon mpts - = let - -- bounds finding isn't vectorised yet. - (llx, lly, rux, ruy) = findBounds mpts - - mpts' = P.fromList $ V.toList mpts - accels' = calcAccelsWithBoxPA epsilon llx lly rux ruy mpts' - - in V.fromList $ P.toList accels' - - --- | Find the coordinates of the bounding box that contains these points. -findBounds :: V.Vector MassPoint -> (Double, Double, Double, Double) -{-# INLINE findBounds #-} -findBounds bounds - = V.foldl' acc (x1, y1, x1, y1) bounds - where - (x1, y1, _) = bounds V.! 0 - - acc (!llx, !lly, !rux, !ruy) (x, y, _) - = let !llx' = min llx x - !lly' = min lly y - !rux' = max rux x - !ruy' = max ruy y - in (llx', lly', rux', ruy') diff --git a/testsuite/tests/dph/nbody/Makefile b/testsuite/tests/dph/nbody/Makefile deleted file mode 100644 index 9101fbd40a..0000000000 --- a/testsuite/tests/dph/nbody/Makefile +++ /dev/null @@ -1,3 +0,0 @@ -TOP=../../.. -include $(TOP)/mk/boilerplate.mk -include $(TOP)/mk/test.mk diff --git a/testsuite/tests/dph/nbody/Randomish.hs b/testsuite/tests/dph/nbody/Randomish.hs deleted file mode 100644 index 7aeefa33d8..0000000000 --- a/testsuite/tests/dph/nbody/Randomish.hs +++ /dev/null @@ -1,82 +0,0 @@ -{-# LANGUAGE BangPatterns #-} - -module Randomish - ( randomishInts - , randomishDoubles) -where -import Data.Word -import Data.Vector.Unboxed (Vector) -import qualified Data.Vector.Unboxed.Mutable as MV -import qualified Data.Vector.Unboxed as V -import qualified Data.Vector.Generic as G - - --- | Use the "minimal standard" Lehmer generator to quickly generate some random --- numbers with reasonable statistical properties. By "reasonable" we mean good --- enough for games and test data, but not cryptography or anything where the --- quality of the randomness really matters. --- --- From "Random Number Generators: Good ones are hard to find" --- Stephen K. Park and Keith W. Miller. --- Communications of the ACM, Oct 1988, Volume 31, Number 10. --- -randomishInts - :: Int -- Length of vector. - -> Int -- Minumum value in output. - -> Int -- Maximum value in output. - -> Int -- Random seed. - -> Vector Int -- Vector of random numbers. - -randomishInts !len !valMin' !valMax' !seed' - - = let -- a magic number (don't change it) - multiplier :: Word64 - multiplier = 16807 - - -- a merzenne prime (don't change it) - modulus :: Word64 - modulus = 2^(31 :: Integer) - 1 - - -- if the seed is 0 all the numbers in the sequence are also 0. - seed - | seed' == 0 = 1 - | otherwise = seed' - - !valMin = fromIntegral valMin' - !valMax = fromIntegral valMax' + 1 - !range = valMax - valMin - - {-# INLINE f #-} - f x = multiplier * x `mod` modulus - in G.create - $ do - vec <- MV.new len - - let go !ix !x - | ix == len = return () - | otherwise - = do let x' = f x - MV.write vec ix $ fromIntegral $ (x `mod` range) + valMin - go (ix + 1) x' - - go 0 (f $ f $ f $ fromIntegral seed) - return vec - - --- | Generate some randomish doubles with terrible statistical properties. --- This is good enough for test data, but not much else. -randomishDoubles - :: Int -- Length of vector - -> Double -- Minimum value in output - -> Double -- Maximum value in output - -> Int -- Random seed. - -> Vector Double -- Vector of randomish doubles. - -randomishDoubles !len !valMin !valMax !seed - = let range = valMax - valMin - - mx = 2^(30 :: Integer) - 1 - mxf = fromIntegral mx - ints = randomishInts len 0 mx seed - - in V.map (\n -> valMin + (fromIntegral n / mxf) * range) ints diff --git a/testsuite/tests/dph/nbody/Solver.hs b/testsuite/tests/dph/nbody/Solver.hs deleted file mode 100644 index a5545b3f2f..0000000000 --- a/testsuite/tests/dph/nbody/Solver.hs +++ /dev/null @@ -1,156 +0,0 @@ -{-# LANGUAGE ParallelArrays #-} -{-# OPTIONS -fvectorise #-} -module Solver - (calcAccelsWithBoxPA) -where -import Data.Array.Parallel -import Data.Array.Parallel.Prelude.Bool -import Data.Array.Parallel.Prelude.Double as D -import qualified Data.Array.Parallel.Prelude.Int as I -import qualified Prelude - -data BoundingBox - = Box Double -- lower left X - Double -- lower left Y - Double -- upper right X - Double -- upper right Y - -data MassPoint - = MP Double -- pos X - Double -- pos Y - Double -- mass - -type Accel - = (Double, Double) - -data BHTree - = BHT Double -- size of cell - Double -- centroid X - Double -- centroid Y - Double -- centroid mass - [:BHTree:] -- children - - -calcAccelsWithBoxPA - :: Double - -> Double -> Double -> Double -> Double - -> PArray (Double, Double, Double) - -> PArray (Double, Double) - -calcAccelsWithBoxPA epsilon llx lly rux ruy mpts - = let mpts' = [: MP x y m | (x, y, m) <- fromPArrayP mpts :] - accs' = calcAccelsWithBox epsilon llx lly rux ruy mpts' - in toPArrayP accs' -{-# NOINLINE calcAccelsWithBoxPA #-} - --- | Given the extend of a bounding box containing all the points, --- calculate the accelerations on all of them. -calcAccelsWithBox - :: Double - -> Double -> Double -> Double -> Double - -> [: MassPoint :] - -> [: Accel :] - -calcAccelsWithBox epsilon llx lly rux ruy mspts - = accs - where accs = [: calcAccel epsilon m tree | m <- mspts :] - tree = buildTree (Box llx lly rux ruy) mspts - - --- | Build the Barnes-Hut quadtree tree. -buildTree :: BoundingBox -> [: MassPoint :] -> BHTree -buildTree bb particles - | lengthP particles I.<= 1 = BHT s x y m emptyP - | otherwise = BHT s x y m subTrees - where (MP x y m) = calcCentroid particles - (boxes, splitPnts) = splitPoints bb particles - subTrees = [:buildTree bb' ps | (bb', ps) <- zipP boxes splitPnts:] - - (Box llx lly rux ruy) = bb - sx = rux D.- llx - sy = ruy D.- lly - s = if sx D.< sy then sx else sy - - --- | Split massPoints according to their locations in the quadrants. -splitPoints - :: BoundingBox - -> [: MassPoint :] - -> ([:BoundingBox:], [:[: MassPoint :]:]) - -splitPoints b@(Box llx lly rux ruy) particles - | noOfPoints I.<= 1 = (singletonP b, singletonP particles) - | otherwise - = unzipP [: (b,p) | (b,p) <- zipP boxes splitPars, lengthP p I.> 0:] - where noOfPoints = lengthP particles - lls = [: p | p <- particles, inBox b1 p :] - lus = [: p | p <- particles, inBox b2 p :] - rus = [: p | p <- particles, inBox b3 p :] - rls = [: p | p <- particles, inBox b4 p :] - b1 = Box llx lly midx midy - b2 = Box llx midy midx ruy - b3 = Box midx midy rux ruy - b4 = Box midx lly rux midy - boxes = singletonP b1 +:+ singletonP b2 +:+ singletonP b3 +:+ singletonP b4 - splitPars = singletonP lls +:+ singletonP lus +:+ singletonP rus +:+ singletonP rls - (midx, midy) = ((llx D.+ rux) D./ 2.0 , (lly D.+ ruy) D./ 2.0) - - --- | Checks if particle is in box (excluding left and lower border) -inBox :: BoundingBox -> MassPoint -> Bool -inBox (Box llx lly rux ruy) (MP px py _) - = (px D.> llx) && (px D.<= rux) && (py D.> lly) && (py D.<= ruy) - - --- | Calculate the centroid of some points. -calcCentroid:: [:MassPoint:] -> MassPoint -calcCentroid mpts - = MP (sumP xs / mass) (sumP ys / mass) mass - where mass = sumP [: m | MP _ _ m <- mpts :] - (xs, ys) = unzipP [: (m D.* x, m D.* y) | MP x y m <- mpts :] - - --- | Calculate the accelleration of a point due to the points in the given tree. -calcAccel :: Double -> MassPoint -> BHTree -> (Double, Double) -calcAccel epsilon mpt (BHT s x y m subtrees) - | lengthP subtrees I.== 0 - = accel epsilon mpt (MP x y m) - - | isFar mpt s x y - = accel epsilon mpt (MP x y m) - - | otherwise - = let (xs, ys) = unzipP [: calcAccel epsilon mpt st | st <- subtrees :] - in (sumP xs, sumP ys) - - --- | Calculate the acceleration on a point due to some other point. -accel :: Double -- ^ If the distance between the points is smaller than this - -- then ignore the forces between them. - -> MassPoint -- ^ The point being acclerated. - -> MassPoint -- ^ Neibouring point. - -> Accel - -accel epsilon (MP x1 y1 _) (MP x2 y2 m) - = (aabs D.* dx D./ r , aabs D.* dy D./ r) - where rsqr = (dx D.* dx) D.+ (dy D.* dy) D.+ epsilon D.* epsilon - r = sqrt rsqr - dx = x1 D.- x2 - dy = y1 D.- y2 - aabs = m D./ rsqr - - --- | If the point is far from a cell in the tree then we can use --- it's centroid as an approximation of all the points in the region. -isFar :: MassPoint -- point being accelerated - -> Double -- size of region - -> Double -- position of center of mass of cell - -> Double -- position of center of mass of cell - -> Bool - -isFar (MP x1 y1 m) s x2 y2 - = let dx = x2 D.- x1 - dy = y2 D.- y1 - dist = sqrt (dx D.* dx D.+ dy D.* dy) - in (s D./ dist) D.< 1 - diff --git a/testsuite/tests/dph/nbody/Types.hs b/testsuite/tests/dph/nbody/Types.hs deleted file mode 100644 index 5ebd849a62..0000000000 --- a/testsuite/tests/dph/nbody/Types.hs +++ /dev/null @@ -1,52 +0,0 @@ -{-# LANGUAGE ParallelArrays #-} -{-# OPTIONS -fvectorise #-} - -module Types - ( Point - , Line - , makePoints, makePointsPA - , xsOf, xsOfPA - , ysOf, ysOfPA) -where -import Data.Array.Parallel -import Data.Array.Parallel.Prelude.Double -import qualified Data.Array.Parallel.Prelude.Double as D -import qualified Prelude as P - -type Point = (Double, Double) -type Line = (Point, Point) - --- | Make some points from their components. -makePoints :: [:Double:] -> [:Double:] -> [:Point:] -makePoints = zipP - - --- | Make some points from their components, as a `PArray`. -makePointsPA :: PArray Double -> PArray Double -> PArray Point -{-# NOINLINE makePointsPA #-} -makePointsPA xs ys - = toPArrayP (makePoints (fromPArrayP xs) (fromPArrayP ys)) - - --- | Take the x values of some points. -xsOf :: [:Point:] -> [:Double:] -xsOf ps = [: x | (x, _) <- ps :] - - --- | Take the x values of some points as a `PArray`. -xsOfPA :: PArray Point -> PArray Double -{-# NOINLINE xsOfPA #-} -xsOfPA ps = toPArrayP (xsOf (fromPArrayP ps)) - - --- | Take the y values of some points. -ysOf :: [:Point:] -> [:Double:] -ysOf ps = [: y | (_, y) <- ps :] - - --- | Take the y values of some points as a `PArray`. -ysOfPA :: PArray Point -> PArray Double -{-# NOINLINE ysOfPA #-} -ysOfPA ps = toPArrayP (ysOf (fromPArrayP ps)) - - diff --git a/testsuite/tests/dph/nbody/Util.hs b/testsuite/tests/dph/nbody/Util.hs deleted file mode 100644 index 5f78802c83..0000000000 --- a/testsuite/tests/dph/nbody/Util.hs +++ /dev/null @@ -1,18 +0,0 @@ - -module Util - ( magV - , mulSV - , normaliseV) -where - --- | The magnitude of a vector. -magV :: (Double, Double) -> Double -magV (x, y) = sqrt (x * x + y * y) - --- | Multiply a vector by a scalar. -mulSV :: Double -> (Double, Double) -> (Double, Double) -mulSV s (x, y) = (s * x, s * y) - --- | Normalise a vector, so it has a magnitude of 1. -normaliseV :: (Double, Double) -> (Double, Double) -normaliseV v = mulSV (1 / magV v) v diff --git a/testsuite/tests/dph/nbody/World.hs b/testsuite/tests/dph/nbody/World.hs deleted file mode 100644 index d858ffb928..0000000000 --- a/testsuite/tests/dph/nbody/World.hs +++ /dev/null @@ -1,47 +0,0 @@ -{-# LANGUAGE BangPatterns #-} - -module World - ( World(..) - , advanceWorld) -where -import Body -import qualified Data.Vector.Unboxed as V - -data World - = World - { -- | Bodies in the simulation. - worldBodies :: !(V.Vector Body) - - -- | Number of steps taken in the simulation so far. - , worldSteps :: !Int } - - --- | Advance the world forward in time. -advanceWorld - :: (V.Vector MassPoint -> V.Vector Accel) - -- ^ Fn to compute accelerations of each point. - -> Double -- ^ Time step. - -> World - -> World - -advanceWorld calcAccels timeStep world - = let -- Calculate the accelerations on each body. - accels = calcAccels - $ V.map massPointOfBody - $ worldBodies world - - -- Apply the accelerations to the bodies and advance them. - bodies' = V.zipWith - (\body (ax, ay) - -> advanceBody timeStep - (setAccelOfBody (-ax, -ay) body)) - (worldBodies world) - accels - - -- Update the world. - steps' = worldSteps world + 1 - - in world { worldBodies = bodies' - , worldSteps = steps' } - -
\ No newline at end of file diff --git a/testsuite/tests/dph/nbody/dph-nbody-copy-fast.stdout b/testsuite/tests/dph/nbody/dph-nbody-copy-fast.stdout deleted file mode 100644 index 69fdd8b303..0000000000 --- a/testsuite/tests/dph/nbody/dph-nbody-copy-fast.stdout +++ /dev/null @@ -1,100 +0,0 @@ - 10.0 -7.88876745 14.40403609 0.07781862 1.41725313 0.00728077 -0.00615418 - 10.0 -20.39602554 -5.40256368 -1.56824530 0.67893475 0.01493099 0.00782011 - 10.0 -0.05794753 10.34183386 0.35651327 0.89460951 0.00188899 -0.00356931 - 10.0 -4.75609397 34.74782948 1.61195437 1.87077953 0.00587195 -0.01975082 - 10.0 36.25896362 10.82337782 2.14170846 -1.41319743 -0.02163268 -0.00507727 - 10.0 4.02674361 -9.00872919 0.03617254 -0.88316283 -0.00122400 0.00926493 - 10.0 42.00406508 -40.85785845 -0.76014767 -3.29738763 -0.02191949 0.02332737 - 10.0 -22.63186030 5.80994447 -1.07420146 1.51160117 0.01670201 0.00006355 - 10.0 16.53870540 16.94639077 1.84926442 0.20378411 -0.00879785 -0.00880553 - 10.0 39.92854878 29.06425991 2.88523318 -1.01552251 -0.02189971 -0.01632925 - 10.0 -17.45501954 11.39301477 -0.56641470 1.60906365 0.01371008 -0.00396360 - 10.0 26.25934753 8.00486951 1.85024443 -0.89918952 -0.01562756 -0.00309898 - 10.0 -9.33900099 9.24549389 -0.36060159 1.12461927 0.00801307 -0.00255620 - 10.0 -46.47873679 -28.36980232 -2.92763912 1.44708065 0.02528654 0.01949016 - 10.0 -12.54370842 34.21722863 1.24120256 2.21072951 0.01080973 -0.01869097 - 10.0 -7.14048930 7.10420057 -0.36081624 0.86670872 0.00647863 -0.00118788 - 10.0 -49.88492485 -23.33817148 -2.76602163 1.78294227 0.02720067 0.01682362 - 10.0 -19.81399282 53.52954568 2.07232227 2.65936299 0.01424146 -0.02727658 - 10.0 23.77418551 14.68227128 2.04725863 -0.41772276 -0.01379116 -0.00752371 - 10.0 -5.73673778 8.93192786 -0.16259409 0.97138466 0.00562305 -0.00245174 - 10.0 10.54277542 -1.02674862 0.84834041 -0.44100517 -0.00531874 0.00383461 - 10.0 23.01197723 21.12299112 2.25990543 -0.12607295 -0.01291140 -0.01176114 - 10.0 -44.78532667 12.05197921 -1.02696812 2.77848076 0.02808850 -0.00298275 - 10.0 31.46388060 -49.75461307 -1.52046945 -3.03579919 -0.01637469 0.02786471 - 10.0 24.84943257 -25.92687211 -0.24060772 -2.45045466 -0.01484349 0.01860299 - 10.0 25.91948874 -30.60444211 -0.52684367 -2.60005186 -0.01516185 0.02084074 - 10.0 -10.85946929 20.87407647 0.39902427 1.82589346 0.00972306 -0.01062660 - 10.0 -38.51435867 1.59076858 -1.56374573 2.10935343 0.02533138 0.00325720 - 10.0 48.51766969 -21.77175738 0.49039776 -3.14884736 -0.02642908 0.01352300 - 10.0 5.74566172 46.44110258 2.61301762 1.41963745 -0.00049448 -0.02602402 - 10.0 -22.88917903 -27.97906439 -2.49898486 -0.03157484 0.01438842 0.02110301 - 10.0 31.73261776 -6.28614087 1.21728705 -1.94829313 -0.01955786 0.00624200 - 10.0 4.24232124 19.44671943 1.21964188 1.10199242 -0.00052277 -0.01009959 - 10.0 0.91334970 48.66777413 2.53737735 1.69247032 0.00244742 -0.02680742 - 10.0 10.67139892 31.69558668 2.17625638 0.97201541 -0.00424894 -0.01856619 - 10.0 12.94163719 58.29627746 3.27732262 1.10311871 -0.00411829 -0.03016643 - 10.0 39.19514702 34.09017661 3.04651632 -0.83806079 -0.02092181 -0.01899392 - 10.0 -24.13067759 -32.16302812 -2.68262548 -0.04506858 0.01454248 0.02301772 - 10.0 51.78333979 -13.45956325 1.00920828 -3.03719366 -0.02816357 0.00875884 - 10.0 -18.73188233 -17.30379387 -1.95701398 -0.00677590 0.01307052 0.01538889 - 10.0 24.70514705 -49.06503148 -1.67808526 -2.78661149 -0.01337746 0.02867654 - 10.0 -51.06940692 -15.61458174 -2.46357376 2.08982818 0.02835174 0.01252356 - 10.0 -4.29154911 -29.69366786 -1.77081329 -1.27717018 0.00330457 0.02241695 - 10.0 2.11752441 33.61609431 1.87012243 1.50451828 0.00141129 -0.01940596 - 10.0 37.73902003 -20.32722331 0.42253535 -2.74138534 -0.02210996 0.01412198 - 10.0 18.24940441 16.13909492 1.89723284 0.04723628 -0.00993771 -0.00831431 - 10.0 -0.86685880 -26.00179392 -1.38458807 -1.39913472 0.00136531 0.02041813 - 10.0 -14.99514725 -9.73327401 -1.49412678 0.04580994 0.01096177 0.01022804 - 10.0 7.00887790 1.98168034 0.68812772 0.00896544 -0.00293511 0.00198547 - 10.0 14.82165676 -26.61468332 -0.63832974 -2.10322539 -0.00891726 0.01991691 - 10.0 36.97393038 41.34508248 3.24972457 -0.53759403 -0.01886630 -0.02264741 - 10.0 13.20164819 -5.94173158 0.74976608 -0.99205532 -0.00725503 0.00697320 - 10.0 -27.55525109 11.38230453 -0.82867230 2.04896832 0.02021279 -0.00334846 - 10.0 44.22611452 7.91205992 2.08170876 -1.97441862 -0.02553919 -0.00334242 - 10.0 -30.78228408 -9.00330845 -1.98277752 1.19492292 0.02083894 0.00999898 - 10.0 21.23162596 1.68817791 1.43493089 -0.91572699 -0.01244008 0.00145281 - 10.0 43.83049777 17.41111171 2.48943804 -1.60943360 -0.02478736 -0.00913389 - 10.0 18.27076095 14.11054567 1.82221570 -0.03605102 -0.01008131 -0.00688670 - 10.0 -23.16386718 14.98115804 -0.48627528 2.03701218 0.01725857 -0.00604352 - 10.0 17.66869644 37.69009924 2.68456831 0.61313519 -0.00829888 -0.02182563 - 10.0 -13.13453980 43.06229834 1.74152194 2.32880687 0.01088136 -0.02345547 - 10.0 17.04551969 -8.51968300 0.74199110 -1.36393081 -0.00992090 0.00843742 - 10.0 -12.74957582 2.86610039 -0.88706993 0.76014301 0.01004519 0.00183585 - 10.0 -11.57352997 -3.93218467 -1.08155095 0.15539312 0.00900597 0.00634724 - 10.0 -0.43691930 11.99128730 0.42464351 1.00896428 0.00223775 -0.00474195 - 10.0 -18.84718297 2.59155114 -1.14765946 1.09328119 0.01395275 0.00224813 - 10.0 26.50822037 34.91831202 2.84251996 -0.01459342 -0.01374681 -0.02010543 - 10.0 -1.83862732 -27.40591387 -1.51844281 -1.37417813 0.00190638 0.02119551 - 10.0 -29.61534814 -11.34773579 -2.05992588 1.01365241 0.02001716 0.01147311 - 10.0 -1.58282077 2.69811157 -0.11418406 0.29617314 0.00265977 0.00167764 - 10.0 2.81028701 8.79669118 0.52804717 0.69094215 -0.00005422 -0.00258329 - 10.0 -46.98701557 11.56383052 -1.07690408 2.84555950 0.02883999 -0.00259972 - 10.0 -3.40737443 -56.06838909 -2.91291405 -1.56839602 0.00150420 0.03217266 - 10.0 -19.98158539 39.46428514 1.28835283 2.57214878 0.01493065 -0.02105105 - 10.0 -44.66881930 12.46139603 -1.00158524 2.78765137 0.02804667 -0.00323063 - 10.0 -16.39650937 23.16371517 0.32747014 2.11248239 0.01323682 -0.01177621 - 10.0 21.95611509 7.76064067 1.72075828 -0.61228724 -0.01269236 -0.00269100 - 10.0 -10.50904475 12.60669705 -0.19243723 1.40501570 0.00897813 -0.00484325 - 10.0 -14.30586541 -0.91198946 -1.12740574 0.55739977 0.01090470 0.00440092 - 10.0 -46.00705467 -6.85206507 -2.04591400 2.14319881 0.02767905 0.00814089 - 10.0 30.41289215 -6.97966533 1.15654150 -1.91885498 -0.01852614 0.00680537 - 10.0 -48.27660341 27.60241976 -0.13762372 3.31622222 0.02879885 -0.01161224 - 10.0 -17.74747450 10.50189167 -0.63686673 1.56720699 0.01384037 -0.00328594 - 10.0 54.39641806 -0.37738366 1.72976962 -2.73607215 -0.02940059 0.00129876 - 10.0 6.47050061 -29.43922970 -1.20659479 -1.82090480 -0.00359394 0.02244751 - 10.0 0.58954963 -13.25292294 -0.49482500 -1.03808365 0.00082873 0.01218738 - 10.0 -12.31468078 -40.73604077 -2.60912850 -0.94516629 0.00720515 0.02765879 - 10.0 38.13312568 24.34484548 2.69648135 -1.04260079 -0.02152543 -0.01341969 - 10.0 -13.70564154 27.92937950 0.77625108 2.14221048 0.01158560 -0.01492998 - 10.0 40.53583366 -0.14911602 1.65704468 -2.10583120 -0.02408788 0.00179315 - 10.0 8.39984292 -15.41302717 -0.12676090 -1.44483730 -0.00437128 0.01330585 - 10.0 22.44930397 -38.06973908 -1.11496697 -2.59958621 -0.01287940 0.02515562 - 10.0 47.41809427 3.44198464 1.88610439 -2.29818650 -0.02696432 -0.00068958 - 10.0 27.36675414 46.97814868 3.25532655 0.14568231 -0.01291442 -0.02560627 - 10.0 -10.16897115 -22.40458265 -1.73420047 -0.76737649 0.00741932 0.01846132 - 10.0 40.36029012 -18.88517950 0.55513182 -2.79063722 -0.02344201 0.01302615 - 10.0 -14.39025584 20.54575351 0.21589623 1.94610689 0.01196694 -0.01021320 - 10.0 19.64156343 34.26658662 2.62377284 0.42861126 -0.00976569 -0.01997954 - 10.0 -33.50298072 43.14541702 1.10503992 3.09224158 0.02172220 -0.02121984 - 10.0 -20.79202850 -24.09713162 -2.28882549 -0.07479119 0.01364036 0.01919977 diff --git a/testsuite/tests/dph/nbody/dph-nbody-copy-opt.stdout b/testsuite/tests/dph/nbody/dph-nbody-copy-opt.stdout deleted file mode 100644 index 69fdd8b303..0000000000 --- a/testsuite/tests/dph/nbody/dph-nbody-copy-opt.stdout +++ /dev/null @@ -1,100 +0,0 @@ - 10.0 -7.88876745 14.40403609 0.07781862 1.41725313 0.00728077 -0.00615418 - 10.0 -20.39602554 -5.40256368 -1.56824530 0.67893475 0.01493099 0.00782011 - 10.0 -0.05794753 10.34183386 0.35651327 0.89460951 0.00188899 -0.00356931 - 10.0 -4.75609397 34.74782948 1.61195437 1.87077953 0.00587195 -0.01975082 - 10.0 36.25896362 10.82337782 2.14170846 -1.41319743 -0.02163268 -0.00507727 - 10.0 4.02674361 -9.00872919 0.03617254 -0.88316283 -0.00122400 0.00926493 - 10.0 42.00406508 -40.85785845 -0.76014767 -3.29738763 -0.02191949 0.02332737 - 10.0 -22.63186030 5.80994447 -1.07420146 1.51160117 0.01670201 0.00006355 - 10.0 16.53870540 16.94639077 1.84926442 0.20378411 -0.00879785 -0.00880553 - 10.0 39.92854878 29.06425991 2.88523318 -1.01552251 -0.02189971 -0.01632925 - 10.0 -17.45501954 11.39301477 -0.56641470 1.60906365 0.01371008 -0.00396360 - 10.0 26.25934753 8.00486951 1.85024443 -0.89918952 -0.01562756 -0.00309898 - 10.0 -9.33900099 9.24549389 -0.36060159 1.12461927 0.00801307 -0.00255620 - 10.0 -46.47873679 -28.36980232 -2.92763912 1.44708065 0.02528654 0.01949016 - 10.0 -12.54370842 34.21722863 1.24120256 2.21072951 0.01080973 -0.01869097 - 10.0 -7.14048930 7.10420057 -0.36081624 0.86670872 0.00647863 -0.00118788 - 10.0 -49.88492485 -23.33817148 -2.76602163 1.78294227 0.02720067 0.01682362 - 10.0 -19.81399282 53.52954568 2.07232227 2.65936299 0.01424146 -0.02727658 - 10.0 23.77418551 14.68227128 2.04725863 -0.41772276 -0.01379116 -0.00752371 - 10.0 -5.73673778 8.93192786 -0.16259409 0.97138466 0.00562305 -0.00245174 - 10.0 10.54277542 -1.02674862 0.84834041 -0.44100517 -0.00531874 0.00383461 - 10.0 23.01197723 21.12299112 2.25990543 -0.12607295 -0.01291140 -0.01176114 - 10.0 -44.78532667 12.05197921 -1.02696812 2.77848076 0.02808850 -0.00298275 - 10.0 31.46388060 -49.75461307 -1.52046945 -3.03579919 -0.01637469 0.02786471 - 10.0 24.84943257 -25.92687211 -0.24060772 -2.45045466 -0.01484349 0.01860299 - 10.0 25.91948874 -30.60444211 -0.52684367 -2.60005186 -0.01516185 0.02084074 - 10.0 -10.85946929 20.87407647 0.39902427 1.82589346 0.00972306 -0.01062660 - 10.0 -38.51435867 1.59076858 -1.56374573 2.10935343 0.02533138 0.00325720 - 10.0 48.51766969 -21.77175738 0.49039776 -3.14884736 -0.02642908 0.01352300 - 10.0 5.74566172 46.44110258 2.61301762 1.41963745 -0.00049448 -0.02602402 - 10.0 -22.88917903 -27.97906439 -2.49898486 -0.03157484 0.01438842 0.02110301 - 10.0 31.73261776 -6.28614087 1.21728705 -1.94829313 -0.01955786 0.00624200 - 10.0 4.24232124 19.44671943 1.21964188 1.10199242 -0.00052277 -0.01009959 - 10.0 0.91334970 48.66777413 2.53737735 1.69247032 0.00244742 -0.02680742 - 10.0 10.67139892 31.69558668 2.17625638 0.97201541 -0.00424894 -0.01856619 - 10.0 12.94163719 58.29627746 3.27732262 1.10311871 -0.00411829 -0.03016643 - 10.0 39.19514702 34.09017661 3.04651632 -0.83806079 -0.02092181 -0.01899392 - 10.0 -24.13067759 -32.16302812 -2.68262548 -0.04506858 0.01454248 0.02301772 - 10.0 51.78333979 -13.45956325 1.00920828 -3.03719366 -0.02816357 0.00875884 - 10.0 -18.73188233 -17.30379387 -1.95701398 -0.00677590 0.01307052 0.01538889 - 10.0 24.70514705 -49.06503148 -1.67808526 -2.78661149 -0.01337746 0.02867654 - 10.0 -51.06940692 -15.61458174 -2.46357376 2.08982818 0.02835174 0.01252356 - 10.0 -4.29154911 -29.69366786 -1.77081329 -1.27717018 0.00330457 0.02241695 - 10.0 2.11752441 33.61609431 1.87012243 1.50451828 0.00141129 -0.01940596 - 10.0 37.73902003 -20.32722331 0.42253535 -2.74138534 -0.02210996 0.01412198 - 10.0 18.24940441 16.13909492 1.89723284 0.04723628 -0.00993771 -0.00831431 - 10.0 -0.86685880 -26.00179392 -1.38458807 -1.39913472 0.00136531 0.02041813 - 10.0 -14.99514725 -9.73327401 -1.49412678 0.04580994 0.01096177 0.01022804 - 10.0 7.00887790 1.98168034 0.68812772 0.00896544 -0.00293511 0.00198547 - 10.0 14.82165676 -26.61468332 -0.63832974 -2.10322539 -0.00891726 0.01991691 - 10.0 36.97393038 41.34508248 3.24972457 -0.53759403 -0.01886630 -0.02264741 - 10.0 13.20164819 -5.94173158 0.74976608 -0.99205532 -0.00725503 0.00697320 - 10.0 -27.55525109 11.38230453 -0.82867230 2.04896832 0.02021279 -0.00334846 - 10.0 44.22611452 7.91205992 2.08170876 -1.97441862 -0.02553919 -0.00334242 - 10.0 -30.78228408 -9.00330845 -1.98277752 1.19492292 0.02083894 0.00999898 - 10.0 21.23162596 1.68817791 1.43493089 -0.91572699 -0.01244008 0.00145281 - 10.0 43.83049777 17.41111171 2.48943804 -1.60943360 -0.02478736 -0.00913389 - 10.0 18.27076095 14.11054567 1.82221570 -0.03605102 -0.01008131 -0.00688670 - 10.0 -23.16386718 14.98115804 -0.48627528 2.03701218 0.01725857 -0.00604352 - 10.0 17.66869644 37.69009924 2.68456831 0.61313519 -0.00829888 -0.02182563 - 10.0 -13.13453980 43.06229834 1.74152194 2.32880687 0.01088136 -0.02345547 - 10.0 17.04551969 -8.51968300 0.74199110 -1.36393081 -0.00992090 0.00843742 - 10.0 -12.74957582 2.86610039 -0.88706993 0.76014301 0.01004519 0.00183585 - 10.0 -11.57352997 -3.93218467 -1.08155095 0.15539312 0.00900597 0.00634724 - 10.0 -0.43691930 11.99128730 0.42464351 1.00896428 0.00223775 -0.00474195 - 10.0 -18.84718297 2.59155114 -1.14765946 1.09328119 0.01395275 0.00224813 - 10.0 26.50822037 34.91831202 2.84251996 -0.01459342 -0.01374681 -0.02010543 - 10.0 -1.83862732 -27.40591387 -1.51844281 -1.37417813 0.00190638 0.02119551 - 10.0 -29.61534814 -11.34773579 -2.05992588 1.01365241 0.02001716 0.01147311 - 10.0 -1.58282077 2.69811157 -0.11418406 0.29617314 0.00265977 0.00167764 - 10.0 2.81028701 8.79669118 0.52804717 0.69094215 -0.00005422 -0.00258329 - 10.0 -46.98701557 11.56383052 -1.07690408 2.84555950 0.02883999 -0.00259972 - 10.0 -3.40737443 -56.06838909 -2.91291405 -1.56839602 0.00150420 0.03217266 - 10.0 -19.98158539 39.46428514 1.28835283 2.57214878 0.01493065 -0.02105105 - 10.0 -44.66881930 12.46139603 -1.00158524 2.78765137 0.02804667 -0.00323063 - 10.0 -16.39650937 23.16371517 0.32747014 2.11248239 0.01323682 -0.01177621 - 10.0 21.95611509 7.76064067 1.72075828 -0.61228724 -0.01269236 -0.00269100 - 10.0 -10.50904475 12.60669705 -0.19243723 1.40501570 0.00897813 -0.00484325 - 10.0 -14.30586541 -0.91198946 -1.12740574 0.55739977 0.01090470 0.00440092 - 10.0 -46.00705467 -6.85206507 -2.04591400 2.14319881 0.02767905 0.00814089 - 10.0 30.41289215 -6.97966533 1.15654150 -1.91885498 -0.01852614 0.00680537 - 10.0 -48.27660341 27.60241976 -0.13762372 3.31622222 0.02879885 -0.01161224 - 10.0 -17.74747450 10.50189167 -0.63686673 1.56720699 0.01384037 -0.00328594 - 10.0 54.39641806 -0.37738366 1.72976962 -2.73607215 -0.02940059 0.00129876 - 10.0 6.47050061 -29.43922970 -1.20659479 -1.82090480 -0.00359394 0.02244751 - 10.0 0.58954963 -13.25292294 -0.49482500 -1.03808365 0.00082873 0.01218738 - 10.0 -12.31468078 -40.73604077 -2.60912850 -0.94516629 0.00720515 0.02765879 - 10.0 38.13312568 24.34484548 2.69648135 -1.04260079 -0.02152543 -0.01341969 - 10.0 -13.70564154 27.92937950 0.77625108 2.14221048 0.01158560 -0.01492998 - 10.0 40.53583366 -0.14911602 1.65704468 -2.10583120 -0.02408788 0.00179315 - 10.0 8.39984292 -15.41302717 -0.12676090 -1.44483730 -0.00437128 0.01330585 - 10.0 22.44930397 -38.06973908 -1.11496697 -2.59958621 -0.01287940 0.02515562 - 10.0 47.41809427 3.44198464 1.88610439 -2.29818650 -0.02696432 -0.00068958 - 10.0 27.36675414 46.97814868 3.25532655 0.14568231 -0.01291442 -0.02560627 - 10.0 -10.16897115 -22.40458265 -1.73420047 -0.76737649 0.00741932 0.01846132 - 10.0 40.36029012 -18.88517950 0.55513182 -2.79063722 -0.02344201 0.01302615 - 10.0 -14.39025584 20.54575351 0.21589623 1.94610689 0.01196694 -0.01021320 - 10.0 19.64156343 34.26658662 2.62377284 0.42861126 -0.00976569 -0.01997954 - 10.0 -33.50298072 43.14541702 1.10503992 3.09224158 0.02172220 -0.02121984 - 10.0 -20.79202850 -24.09713162 -2.28882549 -0.07479119 0.01364036 0.01919977 diff --git a/testsuite/tests/dph/nbody/dph-nbody-vseg-fast.stdout b/testsuite/tests/dph/nbody/dph-nbody-vseg-fast.stdout deleted file mode 100644 index 69fdd8b303..0000000000 --- a/testsuite/tests/dph/nbody/dph-nbody-vseg-fast.stdout +++ /dev/null @@ -1,100 +0,0 @@ - 10.0 -7.88876745 14.40403609 0.07781862 1.41725313 0.00728077 -0.00615418 - 10.0 -20.39602554 -5.40256368 -1.56824530 0.67893475 0.01493099 0.00782011 - 10.0 -0.05794753 10.34183386 0.35651327 0.89460951 0.00188899 -0.00356931 - 10.0 -4.75609397 34.74782948 1.61195437 1.87077953 0.00587195 -0.01975082 - 10.0 36.25896362 10.82337782 2.14170846 -1.41319743 -0.02163268 -0.00507727 - 10.0 4.02674361 -9.00872919 0.03617254 -0.88316283 -0.00122400 0.00926493 - 10.0 42.00406508 -40.85785845 -0.76014767 -3.29738763 -0.02191949 0.02332737 - 10.0 -22.63186030 5.80994447 -1.07420146 1.51160117 0.01670201 0.00006355 - 10.0 16.53870540 16.94639077 1.84926442 0.20378411 -0.00879785 -0.00880553 - 10.0 39.92854878 29.06425991 2.88523318 -1.01552251 -0.02189971 -0.01632925 - 10.0 -17.45501954 11.39301477 -0.56641470 1.60906365 0.01371008 -0.00396360 - 10.0 26.25934753 8.00486951 1.85024443 -0.89918952 -0.01562756 -0.00309898 - 10.0 -9.33900099 9.24549389 -0.36060159 1.12461927 0.00801307 -0.00255620 - 10.0 -46.47873679 -28.36980232 -2.92763912 1.44708065 0.02528654 0.01949016 - 10.0 -12.54370842 34.21722863 1.24120256 2.21072951 0.01080973 -0.01869097 - 10.0 -7.14048930 7.10420057 -0.36081624 0.86670872 0.00647863 -0.00118788 - 10.0 -49.88492485 -23.33817148 -2.76602163 1.78294227 0.02720067 0.01682362 - 10.0 -19.81399282 53.52954568 2.07232227 2.65936299 0.01424146 -0.02727658 - 10.0 23.77418551 14.68227128 2.04725863 -0.41772276 -0.01379116 -0.00752371 - 10.0 -5.73673778 8.93192786 -0.16259409 0.97138466 0.00562305 -0.00245174 - 10.0 10.54277542 -1.02674862 0.84834041 -0.44100517 -0.00531874 0.00383461 - 10.0 23.01197723 21.12299112 2.25990543 -0.12607295 -0.01291140 -0.01176114 - 10.0 -44.78532667 12.05197921 -1.02696812 2.77848076 0.02808850 -0.00298275 - 10.0 31.46388060 -49.75461307 -1.52046945 -3.03579919 -0.01637469 0.02786471 - 10.0 24.84943257 -25.92687211 -0.24060772 -2.45045466 -0.01484349 0.01860299 - 10.0 25.91948874 -30.60444211 -0.52684367 -2.60005186 -0.01516185 0.02084074 - 10.0 -10.85946929 20.87407647 0.39902427 1.82589346 0.00972306 -0.01062660 - 10.0 -38.51435867 1.59076858 -1.56374573 2.10935343 0.02533138 0.00325720 - 10.0 48.51766969 -21.77175738 0.49039776 -3.14884736 -0.02642908 0.01352300 - 10.0 5.74566172 46.44110258 2.61301762 1.41963745 -0.00049448 -0.02602402 - 10.0 -22.88917903 -27.97906439 -2.49898486 -0.03157484 0.01438842 0.02110301 - 10.0 31.73261776 -6.28614087 1.21728705 -1.94829313 -0.01955786 0.00624200 - 10.0 4.24232124 19.44671943 1.21964188 1.10199242 -0.00052277 -0.01009959 - 10.0 0.91334970 48.66777413 2.53737735 1.69247032 0.00244742 -0.02680742 - 10.0 10.67139892 31.69558668 2.17625638 0.97201541 -0.00424894 -0.01856619 - 10.0 12.94163719 58.29627746 3.27732262 1.10311871 -0.00411829 -0.03016643 - 10.0 39.19514702 34.09017661 3.04651632 -0.83806079 -0.02092181 -0.01899392 - 10.0 -24.13067759 -32.16302812 -2.68262548 -0.04506858 0.01454248 0.02301772 - 10.0 51.78333979 -13.45956325 1.00920828 -3.03719366 -0.02816357 0.00875884 - 10.0 -18.73188233 -17.30379387 -1.95701398 -0.00677590 0.01307052 0.01538889 - 10.0 24.70514705 -49.06503148 -1.67808526 -2.78661149 -0.01337746 0.02867654 - 10.0 -51.06940692 -15.61458174 -2.46357376 2.08982818 0.02835174 0.01252356 - 10.0 -4.29154911 -29.69366786 -1.77081329 -1.27717018 0.00330457 0.02241695 - 10.0 2.11752441 33.61609431 1.87012243 1.50451828 0.00141129 -0.01940596 - 10.0 37.73902003 -20.32722331 0.42253535 -2.74138534 -0.02210996 0.01412198 - 10.0 18.24940441 16.13909492 1.89723284 0.04723628 -0.00993771 -0.00831431 - 10.0 -0.86685880 -26.00179392 -1.38458807 -1.39913472 0.00136531 0.02041813 - 10.0 -14.99514725 -9.73327401 -1.49412678 0.04580994 0.01096177 0.01022804 - 10.0 7.00887790 1.98168034 0.68812772 0.00896544 -0.00293511 0.00198547 - 10.0 14.82165676 -26.61468332 -0.63832974 -2.10322539 -0.00891726 0.01991691 - 10.0 36.97393038 41.34508248 3.24972457 -0.53759403 -0.01886630 -0.02264741 - 10.0 13.20164819 -5.94173158 0.74976608 -0.99205532 -0.00725503 0.00697320 - 10.0 -27.55525109 11.38230453 -0.82867230 2.04896832 0.02021279 -0.00334846 - 10.0 44.22611452 7.91205992 2.08170876 -1.97441862 -0.02553919 -0.00334242 - 10.0 -30.78228408 -9.00330845 -1.98277752 1.19492292 0.02083894 0.00999898 - 10.0 21.23162596 1.68817791 1.43493089 -0.91572699 -0.01244008 0.00145281 - 10.0 43.83049777 17.41111171 2.48943804 -1.60943360 -0.02478736 -0.00913389 - 10.0 18.27076095 14.11054567 1.82221570 -0.03605102 -0.01008131 -0.00688670 - 10.0 -23.16386718 14.98115804 -0.48627528 2.03701218 0.01725857 -0.00604352 - 10.0 17.66869644 37.69009924 2.68456831 0.61313519 -0.00829888 -0.02182563 - 10.0 -13.13453980 43.06229834 1.74152194 2.32880687 0.01088136 -0.02345547 - 10.0 17.04551969 -8.51968300 0.74199110 -1.36393081 -0.00992090 0.00843742 - 10.0 -12.74957582 2.86610039 -0.88706993 0.76014301 0.01004519 0.00183585 - 10.0 -11.57352997 -3.93218467 -1.08155095 0.15539312 0.00900597 0.00634724 - 10.0 -0.43691930 11.99128730 0.42464351 1.00896428 0.00223775 -0.00474195 - 10.0 -18.84718297 2.59155114 -1.14765946 1.09328119 0.01395275 0.00224813 - 10.0 26.50822037 34.91831202 2.84251996 -0.01459342 -0.01374681 -0.02010543 - 10.0 -1.83862732 -27.40591387 -1.51844281 -1.37417813 0.00190638 0.02119551 - 10.0 -29.61534814 -11.34773579 -2.05992588 1.01365241 0.02001716 0.01147311 - 10.0 -1.58282077 2.69811157 -0.11418406 0.29617314 0.00265977 0.00167764 - 10.0 2.81028701 8.79669118 0.52804717 0.69094215 -0.00005422 -0.00258329 - 10.0 -46.98701557 11.56383052 -1.07690408 2.84555950 0.02883999 -0.00259972 - 10.0 -3.40737443 -56.06838909 -2.91291405 -1.56839602 0.00150420 0.03217266 - 10.0 -19.98158539 39.46428514 1.28835283 2.57214878 0.01493065 -0.02105105 - 10.0 -44.66881930 12.46139603 -1.00158524 2.78765137 0.02804667 -0.00323063 - 10.0 -16.39650937 23.16371517 0.32747014 2.11248239 0.01323682 -0.01177621 - 10.0 21.95611509 7.76064067 1.72075828 -0.61228724 -0.01269236 -0.00269100 - 10.0 -10.50904475 12.60669705 -0.19243723 1.40501570 0.00897813 -0.00484325 - 10.0 -14.30586541 -0.91198946 -1.12740574 0.55739977 0.01090470 0.00440092 - 10.0 -46.00705467 -6.85206507 -2.04591400 2.14319881 0.02767905 0.00814089 - 10.0 30.41289215 -6.97966533 1.15654150 -1.91885498 -0.01852614 0.00680537 - 10.0 -48.27660341 27.60241976 -0.13762372 3.31622222 0.02879885 -0.01161224 - 10.0 -17.74747450 10.50189167 -0.63686673 1.56720699 0.01384037 -0.00328594 - 10.0 54.39641806 -0.37738366 1.72976962 -2.73607215 -0.02940059 0.00129876 - 10.0 6.47050061 -29.43922970 -1.20659479 -1.82090480 -0.00359394 0.02244751 - 10.0 0.58954963 -13.25292294 -0.49482500 -1.03808365 0.00082873 0.01218738 - 10.0 -12.31468078 -40.73604077 -2.60912850 -0.94516629 0.00720515 0.02765879 - 10.0 38.13312568 24.34484548 2.69648135 -1.04260079 -0.02152543 -0.01341969 - 10.0 -13.70564154 27.92937950 0.77625108 2.14221048 0.01158560 -0.01492998 - 10.0 40.53583366 -0.14911602 1.65704468 -2.10583120 -0.02408788 0.00179315 - 10.0 8.39984292 -15.41302717 -0.12676090 -1.44483730 -0.00437128 0.01330585 - 10.0 22.44930397 -38.06973908 -1.11496697 -2.59958621 -0.01287940 0.02515562 - 10.0 47.41809427 3.44198464 1.88610439 -2.29818650 -0.02696432 -0.00068958 - 10.0 27.36675414 46.97814868 3.25532655 0.14568231 -0.01291442 -0.02560627 - 10.0 -10.16897115 -22.40458265 -1.73420047 -0.76737649 0.00741932 0.01846132 - 10.0 40.36029012 -18.88517950 0.55513182 -2.79063722 -0.02344201 0.01302615 - 10.0 -14.39025584 20.54575351 0.21589623 1.94610689 0.01196694 -0.01021320 - 10.0 19.64156343 34.26658662 2.62377284 0.42861126 -0.00976569 -0.01997954 - 10.0 -33.50298072 43.14541702 1.10503992 3.09224158 0.02172220 -0.02121984 - 10.0 -20.79202850 -24.09713162 -2.28882549 -0.07479119 0.01364036 0.01919977 diff --git a/testsuite/tests/dph/nbody/dph-nbody-vseg-opt.stdout b/testsuite/tests/dph/nbody/dph-nbody-vseg-opt.stdout deleted file mode 100644 index 69fdd8b303..0000000000 --- a/testsuite/tests/dph/nbody/dph-nbody-vseg-opt.stdout +++ /dev/null @@ -1,100 +0,0 @@ - 10.0 -7.88876745 14.40403609 0.07781862 1.41725313 0.00728077 -0.00615418 - 10.0 -20.39602554 -5.40256368 -1.56824530 0.67893475 0.01493099 0.00782011 - 10.0 -0.05794753 10.34183386 0.35651327 0.89460951 0.00188899 -0.00356931 - 10.0 -4.75609397 34.74782948 1.61195437 1.87077953 0.00587195 -0.01975082 - 10.0 36.25896362 10.82337782 2.14170846 -1.41319743 -0.02163268 -0.00507727 - 10.0 4.02674361 -9.00872919 0.03617254 -0.88316283 -0.00122400 0.00926493 - 10.0 42.00406508 -40.85785845 -0.76014767 -3.29738763 -0.02191949 0.02332737 - 10.0 -22.63186030 5.80994447 -1.07420146 1.51160117 0.01670201 0.00006355 - 10.0 16.53870540 16.94639077 1.84926442 0.20378411 -0.00879785 -0.00880553 - 10.0 39.92854878 29.06425991 2.88523318 -1.01552251 -0.02189971 -0.01632925 - 10.0 -17.45501954 11.39301477 -0.56641470 1.60906365 0.01371008 -0.00396360 - 10.0 26.25934753 8.00486951 1.85024443 -0.89918952 -0.01562756 -0.00309898 - 10.0 -9.33900099 9.24549389 -0.36060159 1.12461927 0.00801307 -0.00255620 - 10.0 -46.47873679 -28.36980232 -2.92763912 1.44708065 0.02528654 0.01949016 - 10.0 -12.54370842 34.21722863 1.24120256 2.21072951 0.01080973 -0.01869097 - 10.0 -7.14048930 7.10420057 -0.36081624 0.86670872 0.00647863 -0.00118788 - 10.0 -49.88492485 -23.33817148 -2.76602163 1.78294227 0.02720067 0.01682362 - 10.0 -19.81399282 53.52954568 2.07232227 2.65936299 0.01424146 -0.02727658 - 10.0 23.77418551 14.68227128 2.04725863 -0.41772276 -0.01379116 -0.00752371 - 10.0 -5.73673778 8.93192786 -0.16259409 0.97138466 0.00562305 -0.00245174 - 10.0 10.54277542 -1.02674862 0.84834041 -0.44100517 -0.00531874 0.00383461 - 10.0 23.01197723 21.12299112 2.25990543 -0.12607295 -0.01291140 -0.01176114 - 10.0 -44.78532667 12.05197921 -1.02696812 2.77848076 0.02808850 -0.00298275 - 10.0 31.46388060 -49.75461307 -1.52046945 -3.03579919 -0.01637469 0.02786471 - 10.0 24.84943257 -25.92687211 -0.24060772 -2.45045466 -0.01484349 0.01860299 - 10.0 25.91948874 -30.60444211 -0.52684367 -2.60005186 -0.01516185 0.02084074 - 10.0 -10.85946929 20.87407647 0.39902427 1.82589346 0.00972306 -0.01062660 - 10.0 -38.51435867 1.59076858 -1.56374573 2.10935343 0.02533138 0.00325720 - 10.0 48.51766969 -21.77175738 0.49039776 -3.14884736 -0.02642908 0.01352300 - 10.0 5.74566172 46.44110258 2.61301762 1.41963745 -0.00049448 -0.02602402 - 10.0 -22.88917903 -27.97906439 -2.49898486 -0.03157484 0.01438842 0.02110301 - 10.0 31.73261776 -6.28614087 1.21728705 -1.94829313 -0.01955786 0.00624200 - 10.0 4.24232124 19.44671943 1.21964188 1.10199242 -0.00052277 -0.01009959 - 10.0 0.91334970 48.66777413 2.53737735 1.69247032 0.00244742 -0.02680742 - 10.0 10.67139892 31.69558668 2.17625638 0.97201541 -0.00424894 -0.01856619 - 10.0 12.94163719 58.29627746 3.27732262 1.10311871 -0.00411829 -0.03016643 - 10.0 39.19514702 34.09017661 3.04651632 -0.83806079 -0.02092181 -0.01899392 - 10.0 -24.13067759 -32.16302812 -2.68262548 -0.04506858 0.01454248 0.02301772 - 10.0 51.78333979 -13.45956325 1.00920828 -3.03719366 -0.02816357 0.00875884 - 10.0 -18.73188233 -17.30379387 -1.95701398 -0.00677590 0.01307052 0.01538889 - 10.0 24.70514705 -49.06503148 -1.67808526 -2.78661149 -0.01337746 0.02867654 - 10.0 -51.06940692 -15.61458174 -2.46357376 2.08982818 0.02835174 0.01252356 - 10.0 -4.29154911 -29.69366786 -1.77081329 -1.27717018 0.00330457 0.02241695 - 10.0 2.11752441 33.61609431 1.87012243 1.50451828 0.00141129 -0.01940596 - 10.0 37.73902003 -20.32722331 0.42253535 -2.74138534 -0.02210996 0.01412198 - 10.0 18.24940441 16.13909492 1.89723284 0.04723628 -0.00993771 -0.00831431 - 10.0 -0.86685880 -26.00179392 -1.38458807 -1.39913472 0.00136531 0.02041813 - 10.0 -14.99514725 -9.73327401 -1.49412678 0.04580994 0.01096177 0.01022804 - 10.0 7.00887790 1.98168034 0.68812772 0.00896544 -0.00293511 0.00198547 - 10.0 14.82165676 -26.61468332 -0.63832974 -2.10322539 -0.00891726 0.01991691 - 10.0 36.97393038 41.34508248 3.24972457 -0.53759403 -0.01886630 -0.02264741 - 10.0 13.20164819 -5.94173158 0.74976608 -0.99205532 -0.00725503 0.00697320 - 10.0 -27.55525109 11.38230453 -0.82867230 2.04896832 0.02021279 -0.00334846 - 10.0 44.22611452 7.91205992 2.08170876 -1.97441862 -0.02553919 -0.00334242 - 10.0 -30.78228408 -9.00330845 -1.98277752 1.19492292 0.02083894 0.00999898 - 10.0 21.23162596 1.68817791 1.43493089 -0.91572699 -0.01244008 0.00145281 - 10.0 43.83049777 17.41111171 2.48943804 -1.60943360 -0.02478736 -0.00913389 - 10.0 18.27076095 14.11054567 1.82221570 -0.03605102 -0.01008131 -0.00688670 - 10.0 -23.16386718 14.98115804 -0.48627528 2.03701218 0.01725857 -0.00604352 - 10.0 17.66869644 37.69009924 2.68456831 0.61313519 -0.00829888 -0.02182563 - 10.0 -13.13453980 43.06229834 1.74152194 2.32880687 0.01088136 -0.02345547 - 10.0 17.04551969 -8.51968300 0.74199110 -1.36393081 -0.00992090 0.00843742 - 10.0 -12.74957582 2.86610039 -0.88706993 0.76014301 0.01004519 0.00183585 - 10.0 -11.57352997 -3.93218467 -1.08155095 0.15539312 0.00900597 0.00634724 - 10.0 -0.43691930 11.99128730 0.42464351 1.00896428 0.00223775 -0.00474195 - 10.0 -18.84718297 2.59155114 -1.14765946 1.09328119 0.01395275 0.00224813 - 10.0 26.50822037 34.91831202 2.84251996 -0.01459342 -0.01374681 -0.02010543 - 10.0 -1.83862732 -27.40591387 -1.51844281 -1.37417813 0.00190638 0.02119551 - 10.0 -29.61534814 -11.34773579 -2.05992588 1.01365241 0.02001716 0.01147311 - 10.0 -1.58282077 2.69811157 -0.11418406 0.29617314 0.00265977 0.00167764 - 10.0 2.81028701 8.79669118 0.52804717 0.69094215 -0.00005422 -0.00258329 - 10.0 -46.98701557 11.56383052 -1.07690408 2.84555950 0.02883999 -0.00259972 - 10.0 -3.40737443 -56.06838909 -2.91291405 -1.56839602 0.00150420 0.03217266 - 10.0 -19.98158539 39.46428514 1.28835283 2.57214878 0.01493065 -0.02105105 - 10.0 -44.66881930 12.46139603 -1.00158524 2.78765137 0.02804667 -0.00323063 - 10.0 -16.39650937 23.16371517 0.32747014 2.11248239 0.01323682 -0.01177621 - 10.0 21.95611509 7.76064067 1.72075828 -0.61228724 -0.01269236 -0.00269100 - 10.0 -10.50904475 12.60669705 -0.19243723 1.40501570 0.00897813 -0.00484325 - 10.0 -14.30586541 -0.91198946 -1.12740574 0.55739977 0.01090470 0.00440092 - 10.0 -46.00705467 -6.85206507 -2.04591400 2.14319881 0.02767905 0.00814089 - 10.0 30.41289215 -6.97966533 1.15654150 -1.91885498 -0.01852614 0.00680537 - 10.0 -48.27660341 27.60241976 -0.13762372 3.31622222 0.02879885 -0.01161224 - 10.0 -17.74747450 10.50189167 -0.63686673 1.56720699 0.01384037 -0.00328594 - 10.0 54.39641806 -0.37738366 1.72976962 -2.73607215 -0.02940059 0.00129876 - 10.0 6.47050061 -29.43922970 -1.20659479 -1.82090480 -0.00359394 0.02244751 - 10.0 0.58954963 -13.25292294 -0.49482500 -1.03808365 0.00082873 0.01218738 - 10.0 -12.31468078 -40.73604077 -2.60912850 -0.94516629 0.00720515 0.02765879 - 10.0 38.13312568 24.34484548 2.69648135 -1.04260079 -0.02152543 -0.01341969 - 10.0 -13.70564154 27.92937950 0.77625108 2.14221048 0.01158560 -0.01492998 - 10.0 40.53583366 -0.14911602 1.65704468 -2.10583120 -0.02408788 0.00179315 - 10.0 8.39984292 -15.41302717 -0.12676090 -1.44483730 -0.00437128 0.01330585 - 10.0 22.44930397 -38.06973908 -1.11496697 -2.59958621 -0.01287940 0.02515562 - 10.0 47.41809427 3.44198464 1.88610439 -2.29818650 -0.02696432 -0.00068958 - 10.0 27.36675414 46.97814868 3.25532655 0.14568231 -0.01291442 -0.02560627 - 10.0 -10.16897115 -22.40458265 -1.73420047 -0.76737649 0.00741932 0.01846132 - 10.0 40.36029012 -18.88517950 0.55513182 -2.79063722 -0.02344201 0.01302615 - 10.0 -14.39025584 20.54575351 0.21589623 1.94610689 0.01196694 -0.01021320 - 10.0 19.64156343 34.26658662 2.62377284 0.42861126 -0.00976569 -0.01997954 - 10.0 -33.50298072 43.14541702 1.10503992 3.09224158 0.02172220 -0.02121984 - 10.0 -20.79202850 -24.09713162 -2.28882549 -0.07479119 0.01364036 0.01919977 diff --git a/testsuite/tests/dph/nbody/dph-nbody.T b/testsuite/tests/dph/nbody/dph-nbody.T deleted file mode 100644 index 11ee313882..0000000000 --- a/testsuite/tests/dph/nbody/dph-nbody.T +++ /dev/null @@ -1,19 +0,0 @@ - -test ('dph-nbody-vseg-fast' - , [ outputdir('vseg-fast') - , reqlib('dph-lifted-vseg') - , reqlib('dph-prim-par') - , only_ways(['normal', 'threaded1', 'threaded2']) ] - , multimod_compile_and_run - , [ 'Main' - , '-O0 -package dph-lifted-vseg -package dph-prim-par']) - - -test ('dph-nbody-copy-fast' - , [ outputdir('copy-fast') - , reqlib('dph-lifted-copy') - , reqlib('dph-prim-par') - , only_ways(['normal', 'threaded1', 'threaded2']) ] - , multimod_compile_and_run - , [ 'Main' - , '-O0 -fno-vectorisation-avoidance -package dph-lifted-copy -package dph-prim-par']) diff --git a/testsuite/tests/dph/primespj/Main.hs b/testsuite/tests/dph/primespj/Main.hs deleted file mode 100644 index f7a3ed1fe5..0000000000 --- a/testsuite/tests/dph/primespj/Main.hs +++ /dev/null @@ -1,30 +0,0 @@ -import Control.Exception (evaluate) -import System.Console.GetOpt - -import Data.Array.Parallel.PArray (PArray) -import qualified Data.Array.Parallel.PArray as P - -import PrimesVect (primesVect) -import Debug.Trace - - -primesList :: Int -> [Int] -primesList 1 = [] -primesList n = sps ++ [ i | i <- [sq+1..n], multiple sps i ] - where - sps = primesList sq - sq = floor $ sqrt $ fromIntegral n - - multiple :: [Int] -> Int -> Bool - multiple ps i = and [i `mod` p /= 0 | p <- ps] - - -main - = do let n = 1000 - let resultViaNDP = P.toList $ primesVect n - let resultViaLists = primesList n - - print resultViaNDP - print resultViaLists - print $ resultViaNDP == resultViaLists - diff --git a/testsuite/tests/dph/primespj/Makefile b/testsuite/tests/dph/primespj/Makefile deleted file mode 100644 index 9101fbd40a..0000000000 --- a/testsuite/tests/dph/primespj/Makefile +++ /dev/null @@ -1,3 +0,0 @@ -TOP=../../.. -include $(TOP)/mk/boilerplate.mk -include $(TOP)/mk/test.mk diff --git a/testsuite/tests/dph/primespj/PrimesVect.hs b/testsuite/tests/dph/primespj/PrimesVect.hs deleted file mode 100644 index 34b3a568b7..0000000000 --- a/testsuite/tests/dph/primespj/PrimesVect.hs +++ /dev/null @@ -1,25 +0,0 @@ -{-# LANGUAGE ParallelArrays #-} -{-# OPTIONS -fvectorise #-} -module PrimesVect (primesVect) - -where -import Data.Array.Parallel -import Data.Array.Parallel.Prelude.Int -import qualified Prelude - -primesVect:: Int -> PArray Int -primesVect n = toPArrayP (primesVect' n) - -primesVect':: Int -> [:Int:] -primesVect' n - | n == 1 = emptyP - | n == 2 = singletonP 2 - | otherwise = sps +:+ [: i | i <- enumFromToP (sq+1) n, notMultiple sps i:] - where - - sps = primesVect' sq - sq = sqrt n - - notMultiple :: [:Int:] -> Int -> Bool - notMultiple ps i = andP [: mod i p /= 0 | p <- ps:] - diff --git a/testsuite/tests/dph/primespj/dph-primespj-copy-fast.stdout b/testsuite/tests/dph/primespj/dph-primespj-copy-fast.stdout deleted file mode 100644 index d935f68b11..0000000000 --- a/testsuite/tests/dph/primespj/dph-primespj-copy-fast.stdout +++ /dev/null @@ -1,3 +0,0 @@ -[2,3,5,7,11,13,17,19,23,29,31,37,41,43,47,53,59,61,67,71,73,79,83,89,97,101,103,107,109,113,127,131,137,139,149,151,157,163,167,173,179,181,191,193,197,199,211,223,227,229,233,239,241,251,257,263,269,271,277,281,283,293,307,311,313,317,331,337,347,349,353,359,367,373,379,383,389,397,401,409,419,421,431,433,439,443,449,457,461,463,467,479,487,491,499,503,509,521,523,541,547,557,563,569,571,577,587,593,599,601,607,613,617,619,631,641,643,647,653,659,661,673,677,683,691,701,709,719,727,733,739,743,751,757,761,769,773,787,797,809,811,821,823,827,829,839,853,857,859,863,877,881,883,887,907,911,919,929,937,941,947,953,967,971,977,983,991,997] -[2,3,5,7,11,13,17,19,23,29,31,37,41,43,47,53,59,61,67,71,73,79,83,89,97,101,103,107,109,113,127,131,137,139,149,151,157,163,167,173,179,181,191,193,197,199,211,223,227,229,233,239,241,251,257,263,269,271,277,281,283,293,307,311,313,317,331,337,347,349,353,359,367,373,379,383,389,397,401,409,419,421,431,433,439,443,449,457,461,463,467,479,487,491,499,503,509,521,523,541,547,557,563,569,571,577,587,593,599,601,607,613,617,619,631,641,643,647,653,659,661,673,677,683,691,701,709,719,727,733,739,743,751,757,761,769,773,787,797,809,811,821,823,827,829,839,853,857,859,863,877,881,883,887,907,911,919,929,937,941,947,953,967,971,977,983,991,997] -True diff --git a/testsuite/tests/dph/primespj/dph-primespj-copy-opt.stdout b/testsuite/tests/dph/primespj/dph-primespj-copy-opt.stdout deleted file mode 100644 index d935f68b11..0000000000 --- a/testsuite/tests/dph/primespj/dph-primespj-copy-opt.stdout +++ /dev/null @@ -1,3 +0,0 @@ -[2,3,5,7,11,13,17,19,23,29,31,37,41,43,47,53,59,61,67,71,73,79,83,89,97,101,103,107,109,113,127,131,137,139,149,151,157,163,167,173,179,181,191,193,197,199,211,223,227,229,233,239,241,251,257,263,269,271,277,281,283,293,307,311,313,317,331,337,347,349,353,359,367,373,379,383,389,397,401,409,419,421,431,433,439,443,449,457,461,463,467,479,487,491,499,503,509,521,523,541,547,557,563,569,571,577,587,593,599,601,607,613,617,619,631,641,643,647,653,659,661,673,677,683,691,701,709,719,727,733,739,743,751,757,761,769,773,787,797,809,811,821,823,827,829,839,853,857,859,863,877,881,883,887,907,911,919,929,937,941,947,953,967,971,977,983,991,997] -[2,3,5,7,11,13,17,19,23,29,31,37,41,43,47,53,59,61,67,71,73,79,83,89,97,101,103,107,109,113,127,131,137,139,149,151,157,163,167,173,179,181,191,193,197,199,211,223,227,229,233,239,241,251,257,263,269,271,277,281,283,293,307,311,313,317,331,337,347,349,353,359,367,373,379,383,389,397,401,409,419,421,431,433,439,443,449,457,461,463,467,479,487,491,499,503,509,521,523,541,547,557,563,569,571,577,587,593,599,601,607,613,617,619,631,641,643,647,653,659,661,673,677,683,691,701,709,719,727,733,739,743,751,757,761,769,773,787,797,809,811,821,823,827,829,839,853,857,859,863,877,881,883,887,907,911,919,929,937,941,947,953,967,971,977,983,991,997] -True diff --git a/testsuite/tests/dph/primespj/dph-primespj-vseg-fast.stdout b/testsuite/tests/dph/primespj/dph-primespj-vseg-fast.stdout deleted file mode 100644 index d935f68b11..0000000000 --- a/testsuite/tests/dph/primespj/dph-primespj-vseg-fast.stdout +++ /dev/null @@ -1,3 +0,0 @@ -[2,3,5,7,11,13,17,19,23,29,31,37,41,43,47,53,59,61,67,71,73,79,83,89,97,101,103,107,109,113,127,131,137,139,149,151,157,163,167,173,179,181,191,193,197,199,211,223,227,229,233,239,241,251,257,263,269,271,277,281,283,293,307,311,313,317,331,337,347,349,353,359,367,373,379,383,389,397,401,409,419,421,431,433,439,443,449,457,461,463,467,479,487,491,499,503,509,521,523,541,547,557,563,569,571,577,587,593,599,601,607,613,617,619,631,641,643,647,653,659,661,673,677,683,691,701,709,719,727,733,739,743,751,757,761,769,773,787,797,809,811,821,823,827,829,839,853,857,859,863,877,881,883,887,907,911,919,929,937,941,947,953,967,971,977,983,991,997] -[2,3,5,7,11,13,17,19,23,29,31,37,41,43,47,53,59,61,67,71,73,79,83,89,97,101,103,107,109,113,127,131,137,139,149,151,157,163,167,173,179,181,191,193,197,199,211,223,227,229,233,239,241,251,257,263,269,271,277,281,283,293,307,311,313,317,331,337,347,349,353,359,367,373,379,383,389,397,401,409,419,421,431,433,439,443,449,457,461,463,467,479,487,491,499,503,509,521,523,541,547,557,563,569,571,577,587,593,599,601,607,613,617,619,631,641,643,647,653,659,661,673,677,683,691,701,709,719,727,733,739,743,751,757,761,769,773,787,797,809,811,821,823,827,829,839,853,857,859,863,877,881,883,887,907,911,919,929,937,941,947,953,967,971,977,983,991,997] -True diff --git a/testsuite/tests/dph/primespj/dph-primespj-vseg-opt.stdout b/testsuite/tests/dph/primespj/dph-primespj-vseg-opt.stdout deleted file mode 100644 index d935f68b11..0000000000 --- a/testsuite/tests/dph/primespj/dph-primespj-vseg-opt.stdout +++ /dev/null @@ -1,3 +0,0 @@ -[2,3,5,7,11,13,17,19,23,29,31,37,41,43,47,53,59,61,67,71,73,79,83,89,97,101,103,107,109,113,127,131,137,139,149,151,157,163,167,173,179,181,191,193,197,199,211,223,227,229,233,239,241,251,257,263,269,271,277,281,283,293,307,311,313,317,331,337,347,349,353,359,367,373,379,383,389,397,401,409,419,421,431,433,439,443,449,457,461,463,467,479,487,491,499,503,509,521,523,541,547,557,563,569,571,577,587,593,599,601,607,613,617,619,631,641,643,647,653,659,661,673,677,683,691,701,709,719,727,733,739,743,751,757,761,769,773,787,797,809,811,821,823,827,829,839,853,857,859,863,877,881,883,887,907,911,919,929,937,941,947,953,967,971,977,983,991,997] -[2,3,5,7,11,13,17,19,23,29,31,37,41,43,47,53,59,61,67,71,73,79,83,89,97,101,103,107,109,113,127,131,137,139,149,151,157,163,167,173,179,181,191,193,197,199,211,223,227,229,233,239,241,251,257,263,269,271,277,281,283,293,307,311,313,317,331,337,347,349,353,359,367,373,379,383,389,397,401,409,419,421,431,433,439,443,449,457,461,463,467,479,487,491,499,503,509,521,523,541,547,557,563,569,571,577,587,593,599,601,607,613,617,619,631,641,643,647,653,659,661,673,677,683,691,701,709,719,727,733,739,743,751,757,761,769,773,787,797,809,811,821,823,827,829,839,853,857,859,863,877,881,883,887,907,911,919,929,937,941,947,953,967,971,977,983,991,997] -True diff --git a/testsuite/tests/dph/primespj/dph-primespj.T b/testsuite/tests/dph/primespj/dph-primespj.T deleted file mode 100644 index 8b45cc80e7..0000000000 --- a/testsuite/tests/dph/primespj/dph-primespj.T +++ /dev/null @@ -1,11 +0,0 @@ - -test ('dph-primespj-copy-fast' - , [ outputdir('fast') - , reqlib('dph-lifted-copy') - , reqlib('dph-prim-par') - , only_ways(['normal', 'threaded1', 'threaded2']) ] - , multimod_compile_and_run - , [ 'Main' - , '-O0 -package dph-lifted-copy']) - - diff --git a/testsuite/tests/dph/quickhull/Main.hs b/testsuite/tests/dph/quickhull/Main.hs deleted file mode 100644 index e1dc04ba24..0000000000 --- a/testsuite/tests/dph/quickhull/Main.hs +++ /dev/null @@ -1,43 +0,0 @@ - -import qualified Types as QH -import QuickHullVect (quickhull) - -import qualified Data.Array.Parallel.Unlifted as U -import qualified Data.Array.Parallel.Prelude as P - -import qualified Data.Array.Parallel.PArray as P -import Data.Array.Parallel.PArray (PArray) - -import System.Environment -import Data.List - -import SVG -import TestData - - ------ -runQuickhull :: PArray QH.Point -> [(Double, Double)] -runQuickhull pts - = let result = quickhull pts - resxs = P.toUArray (QH.xsOf result) - resys = P.toUArray (QH.ysOf result) - in U.index "runQuickhull" resxs 0 `seq` (zip (U.toList resxs) (U.toList resys)) - - --- Main Program --------------------------------------------------------------- -main - = do args <- getArgs - let n = case args of - [s] -> read s - _ -> 1000 - - paInput <- toPArrayPoints - $ genPointsCombo n - - let psHull = runQuickhull paInput - psInput = P.toList paInput - - putStr - $ makeSVG - (roundPoints psInput) - (roundPoints psHull) diff --git a/testsuite/tests/dph/quickhull/Makefile b/testsuite/tests/dph/quickhull/Makefile deleted file mode 100644 index 9101fbd40a..0000000000 --- a/testsuite/tests/dph/quickhull/Makefile +++ /dev/null @@ -1,3 +0,0 @@ -TOP=../../.. -include $(TOP)/mk/boilerplate.mk -include $(TOP)/mk/test.mk diff --git a/testsuite/tests/dph/quickhull/QuickHullVect.hs b/testsuite/tests/dph/quickhull/QuickHullVect.hs deleted file mode 100644 index e0ad75858d..0000000000 --- a/testsuite/tests/dph/quickhull/QuickHullVect.hs +++ /dev/null @@ -1,41 +0,0 @@ -{-# LANGUAGE ParallelArrays #-} -{-# OPTIONS -fvectorise #-} - -module QuickHullVect (quickhull) where - -import Types - -import Data.Array.Parallel -import Data.Array.Parallel.Prelude.Double as D -import qualified Data.Array.Parallel.Prelude.Int as Int - -import qualified Prelude as P - -distance :: Point -> Line -> Double -distance (xo, yo) ((x1, y1), (x2, y2)) - = (x1 D.- xo) D.* (y2 D.- yo) D.- (y1 D.- yo) D.* (x2 D.- xo) - -hsplit :: [:Point:] -> Line -> [:Point:] -hsplit points line@(p1, p2) - | lengthP packed Int.< 2 = singletonP p1 +:+ packed - | otherwise - = concatP [: hsplit packed ends | ends <- [:(p1, pm), (pm, p2):] :] - where - cross = [: distance p line | p <- points :] - packed = [: p | (p,c) <- zipP points cross, c D.> 0.0 :] - pm = points !: maxIndexP cross - -quickHull' :: [:Point:] -> [:Point:] -quickHull' points - | lengthP points Int.== 0 = points - | otherwise - = concatP [: hsplit points ends | ends <- [: (minx, maxx), (maxx, minx) :] :] - where - xs = [: x | (x, y) <- points :] - minx = points !: minIndexP xs - maxx = points !: maxIndexP xs - -quickhull :: PArray Point -> PArray Point -{-# NOINLINE quickhull #-} -quickhull ps = toPArrayP (quickHull' (fromPArrayP ps)) - diff --git a/testsuite/tests/dph/quickhull/SVG.hs b/testsuite/tests/dph/quickhull/SVG.hs deleted file mode 100644 index c750fb06f5..0000000000 --- a/testsuite/tests/dph/quickhull/SVG.hs +++ /dev/null @@ -1,34 +0,0 @@ - -module SVG where - --- Making a SVG diagram of the points and hull -makeSVG :: [(Int, Int)] -> [(Int, Int)] -> String -makeSVG points hull - = unlines - $ [ "<svg width=\"100%\" height=\"100%\" version=\"1.1\" xmlns=\"http://www.w3.org/2000/svg\">" ] - ++ [svgPolygon hull] - ++ map svgPoint points - ++ map svgPointHull hull - ++ ["</svg>"] - -svgPolygon :: [(Int, Int)] -> String -svgPolygon points - = "<polygon" - ++ " points=\"" ++ (concat [show x ++ "," ++ show y ++ " " | (x, y) <- points]) ++ "\"" - ++ " style=\"fill:#d0d0ff;stroke:#000000;stroke-width:1\"" - ++ "/>" - -svgPoint :: (Int, Int) -> String -svgPoint (x, y) - = "<circle cx=\"" ++ show x ++ "\" cy=\"" ++ show y ++ "\" r=\"0.5\"" - ++ " style=\"stroke:#000000\"" - ++ "/>" - -svgPointHull :: (Int, Int) -> String -svgPointHull (x, y) - = "<circle cx=\"" ++ show x ++ "\" cy=\"" ++ show y ++ "\" r=\"1\"" - ++ " style=\"stroke:#ff0000\"" - ++ "/>" - -roundPoints :: [(Double, Double)] -> [(Int, Int)] -roundPoints ps = [(round x, round y) | (x, y) <- ps] diff --git a/testsuite/tests/dph/quickhull/TestData.hs b/testsuite/tests/dph/quickhull/TestData.hs deleted file mode 100644 index a27cca288e..0000000000 --- a/testsuite/tests/dph/quickhull/TestData.hs +++ /dev/null @@ -1,92 +0,0 @@ - -module TestData - ( genPointsUniform - , genPointsDisc - , genPointsCombo - , toPArrayPoints ) -where - -import qualified Types as QH -import qualified Data.Array.Parallel.Unlifted as U -import qualified Data.Array.Parallel.Prelude as P -import qualified Data.Array.Parallel.Prelude.Double as D -import qualified Data.Array.Parallel.PArray as P -import Data.Array.Parallel.PArray (PArray) - -import System.Random -import Control.Exception - --- Random points generation --- IMPORTANT: We use the same seed with the same random generator in all --- quickhull codes. The asymptotic work complexity of quickhull --- is between O (N) and O (N^2) depending on the input. --- To compare benchmark results, they always need to use the same --- input. -seed = 42742 - --- | Some uniformly distributed points -genPointsUniform - :: Int -- ^ number of points - -> Double -- ^ minimum coordinate - -> Double -- ^ maximum coordinate - -> [(Double, Double)] - -genPointsUniform n minXY maxXY - = let - pointMin = 10 - pointMax = 510 - gen = mkStdGen seed - in toPairs $ take (2*n) $ randomRs (pointMin, pointMax) gen - -toPairs [] = [] -toPairs (x:y:pts) = (x, y) : toPairs pts - - --- | Some points distributed as a disc -genPointsDisc - :: Int -- ^ number of points - -> (Double, Double) -- ^ center of disc - -> Double -- ^ radius of disc - -> [(Double, Double)] - -genPointsDisc n (originX, originY) radiusMax - = let (genRadius, genAngle) - = split $ mkStdGen seed - - radius = take n $ randomRs (0, radiusMax) genRadius - angle = take n $ randomRs (- pi, pi) genAngle - - makeXY (r, a) - = ( originX + r * cos a - , originY + r * sin a) - - in map makeXY $ zip radius angle - - --- | A point cloud with areas of high an low density -genPointsCombo - :: Int -- ^ number of points - -> [(Double, Double)] - -genPointsCombo n - = genPointsDisc (n `div` 5) (250, 250) 200 - ++ genPointsDisc (n `div` 5) (100, 100) 80 - ++ genPointsDisc (n `div` 5) (150, 300) 30 - ++ genPointsDisc (n `div` 5) (500, 120) 30 - ++ genPointsDisc (n `div` 5) (300, 200) 150 - - --- | Convert a list of points to a PArray -toPArrayPoints :: [(Double, Double)] -> IO (PArray QH.Point) -toPArrayPoints ps - = do let pts = QH.points (P.fromList (map fst ps)) - (P.fromList (map snd ps)) - evaluate $ force pts - return pts - --- | Force points to be evaluated -force pts - = U.index "TestData" (P.toUArray (QH.xsOf pts)) 0 D.+ - U.index "TestData" (P.toUArray (QH.ysOf pts)) 0 - - diff --git a/testsuite/tests/dph/quickhull/Types.hs b/testsuite/tests/dph/quickhull/Types.hs deleted file mode 100644 index 6b19ef1ab3..0000000000 --- a/testsuite/tests/dph/quickhull/Types.hs +++ /dev/null @@ -1,33 +0,0 @@ -{-# LANGUAGE ParallelArrays #-} -{-# OPTIONS -fvectorise #-} - -module Types ( Point, Line, points, xsOf, ysOf) where - -import Data.Array.Parallel -import Data.Array.Parallel.Prelude.Double - -type Point = (Double, Double) -type Line = (Point, Point) - -points' :: [:Double:] -> [:Double:] -> [:Point:] -points' = zipP - -points :: PArray Double -> PArray Double -> PArray Point -{-# NOINLINE points #-} -points xs ys = toPArrayP (points' (fromPArrayP xs) (fromPArrayP ys)) - -xsOf' :: [:Point:] -> [:Double:] -xsOf' ps = [: x | (x, _) <- ps :] - -xsOf :: PArray Point -> PArray Double -{-# NOINLINE xsOf #-} -xsOf ps = toPArrayP (xsOf' (fromPArrayP ps)) - -ysOf' :: [:Point:] -> [:Double:] -ysOf' ps = [: y | (_, y) <- ps :] - -ysOf :: PArray Point -> PArray Double -{-# NOINLINE ysOf #-} -ysOf ps = toPArrayP (ysOf' (fromPArrayP ps)) - - diff --git a/testsuite/tests/dph/quickhull/dph-quickhull-copy-fast.stdout b/testsuite/tests/dph/quickhull/dph-quickhull-copy-fast.stdout deleted file mode 100644 index f6b2d92e9a..0000000000 --- a/testsuite/tests/dph/quickhull/dph-quickhull-copy-fast.stdout +++ /dev/null @@ -1,1019 +0,0 @@ -<svg width="100%" height="100%" version="1.1" xmlns="http://www.w3.org/2000/svg"> -<polygon points="20,98 50,246 83,354 164,416 236,434 343,427 366,412 379,402 519,143 528,126 529,115 510,96 506,95 117,33 85,28 40,64 " style="fill:#d0d0ff;stroke:#000000;stroke-width:1"/> -<circle cx="217" cy="201" r="0.5" style="stroke:#000000"/> -<circle cx="310" cy="266" r="0.5" style="stroke:#000000"/> -<circle cx="191" cy="353" r="0.5" style="stroke:#000000"/> -<circle cx="164" cy="416" r="0.5" style="stroke:#000000"/> -<circle cx="232" cy="257" r="0.5" style="stroke:#000000"/> -<circle cx="266" cy="398" r="0.5" style="stroke:#000000"/> -<circle cx="350" cy="201" r="0.5" style="stroke:#000000"/> -<circle cx="334" cy="202" r="0.5" style="stroke:#000000"/> -<circle cx="189" cy="151" r="0.5" style="stroke:#000000"/> -<circle cx="308" cy="307" r="0.5" style="stroke:#000000"/> -<circle cx="347" cy="160" r="0.5" style="stroke:#000000"/> -<circle cx="251" cy="251" r="0.5" style="stroke:#000000"/> -<circle cx="275" cy="241" r="0.5" style="stroke:#000000"/> -<circle cx="275" cy="398" r="0.5" style="stroke:#000000"/> -<circle cx="167" cy="292" r="0.5" style="stroke:#000000"/> -<circle cx="351" cy="397" r="0.5" style="stroke:#000000"/> -<circle cx="257" cy="254" r="0.5" style="stroke:#000000"/> -<circle cx="248" cy="220" r="0.5" style="stroke:#000000"/> -<circle cx="250" cy="252" r="0.5" style="stroke:#000000"/> -<circle cx="191" cy="222" r="0.5" style="stroke:#000000"/> -<circle cx="93" cy="200" r="0.5" style="stroke:#000000"/> -<circle cx="155" cy="195" r="0.5" style="stroke:#000000"/> -<circle cx="287" cy="84" r="0.5" style="stroke:#000000"/> -<circle cx="90" cy="198" r="0.5" style="stroke:#000000"/> -<circle cx="149" cy="175" r="0.5" style="stroke:#000000"/> -<circle cx="342" cy="311" r="0.5" style="stroke:#000000"/> -<circle cx="391" cy="360" r="0.5" style="stroke:#000000"/> -<circle cx="277" cy="310" r="0.5" style="stroke:#000000"/> -<circle cx="341" cy="421" r="0.5" style="stroke:#000000"/> -<circle cx="274" cy="136" r="0.5" style="stroke:#000000"/> -<circle cx="187" cy="278" r="0.5" style="stroke:#000000"/> -<circle cx="343" cy="427" r="0.5" style="stroke:#000000"/> -<circle cx="255" cy="170" r="0.5" style="stroke:#000000"/> -<circle cx="158" cy="329" r="0.5" style="stroke:#000000"/> -<circle cx="306" cy="196" r="0.5" style="stroke:#000000"/> -<circle cx="315" cy="261" r="0.5" style="stroke:#000000"/> -<circle cx="214" cy="361" r="0.5" style="stroke:#000000"/> -<circle cx="306" cy="304" r="0.5" style="stroke:#000000"/> -<circle cx="229" cy="219" r="0.5" style="stroke:#000000"/> -<circle cx="227" cy="351" r="0.5" style="stroke:#000000"/> -<circle cx="228" cy="196" r="0.5" style="stroke:#000000"/> -<circle cx="314" cy="280" r="0.5" style="stroke:#000000"/> -<circle cx="209" cy="195" r="0.5" style="stroke:#000000"/> -<circle cx="367" cy="217" r="0.5" style="stroke:#000000"/> -<circle cx="176" cy="212" r="0.5" style="stroke:#000000"/> -<circle cx="117" cy="194" r="0.5" style="stroke:#000000"/> -<circle cx="318" cy="116" r="0.5" style="stroke:#000000"/> -<circle cx="250" cy="251" r="0.5" style="stroke:#000000"/> -<circle cx="355" cy="406" r="0.5" style="stroke:#000000"/> -<circle cx="252" cy="246" r="0.5" style="stroke:#000000"/> -<circle cx="219" cy="299" r="0.5" style="stroke:#000000"/> -<circle cx="217" cy="232" r="0.5" style="stroke:#000000"/> -<circle cx="283" cy="220" r="0.5" style="stroke:#000000"/> -<circle cx="239" cy="207" r="0.5" style="stroke:#000000"/> -<circle cx="266" cy="255" r="0.5" style="stroke:#000000"/> -<circle cx="310" cy="324" r="0.5" style="stroke:#000000"/> -<circle cx="200" cy="248" r="0.5" style="stroke:#000000"/> -<circle cx="387" cy="360" r="0.5" style="stroke:#000000"/> -<circle cx="147" cy="186" r="0.5" style="stroke:#000000"/> -<circle cx="126" cy="236" r="0.5" style="stroke:#000000"/> -<circle cx="257" cy="300" r="0.5" style="stroke:#000000"/> -<circle cx="255" cy="250" r="0.5" style="stroke:#000000"/> -<circle cx="50" cy="246" r="0.5" style="stroke:#000000"/> -<circle cx="231" cy="340" r="0.5" style="stroke:#000000"/> -<circle cx="189" cy="287" r="0.5" style="stroke:#000000"/> -<circle cx="188" cy="186" r="0.5" style="stroke:#000000"/> -<circle cx="366" cy="412" r="0.5" style="stroke:#000000"/> -<circle cx="183" cy="139" r="0.5" style="stroke:#000000"/> -<circle cx="305" cy="113" r="0.5" style="stroke:#000000"/> -<circle cx="286" cy="146" r="0.5" style="stroke:#000000"/> -<circle cx="399" cy="241" r="0.5" style="stroke:#000000"/> -<circle cx="289" cy="404" r="0.5" style="stroke:#000000"/> -<circle cx="346" cy="157" r="0.5" style="stroke:#000000"/> -<circle cx="287" cy="143" r="0.5" style="stroke:#000000"/> -<circle cx="223" cy="236" r="0.5" style="stroke:#000000"/> -<circle cx="181" cy="159" r="0.5" style="stroke:#000000"/> -<circle cx="134" cy="249" r="0.5" style="stroke:#000000"/> -<circle cx="238" cy="274" r="0.5" style="stroke:#000000"/> -<circle cx="246" cy="250" r="0.5" style="stroke:#000000"/> -<circle cx="201" cy="395" r="0.5" style="stroke:#000000"/> -<circle cx="192" cy="116" r="0.5" style="stroke:#000000"/> -<circle cx="260" cy="296" r="0.5" style="stroke:#000000"/> -<circle cx="244" cy="399" r="0.5" style="stroke:#000000"/> -<circle cx="256" cy="303" r="0.5" style="stroke:#000000"/> -<circle cx="202" cy="221" r="0.5" style="stroke:#000000"/> -<circle cx="361" cy="406" r="0.5" style="stroke:#000000"/> -<circle cx="275" cy="235" r="0.5" style="stroke:#000000"/> -<circle cx="180" cy="305" r="0.5" style="stroke:#000000"/> -<circle cx="258" cy="241" r="0.5" style="stroke:#000000"/> -<circle cx="253" cy="237" r="0.5" style="stroke:#000000"/> -<circle cx="239" cy="408" r="0.5" style="stroke:#000000"/> -<circle cx="247" cy="254" r="0.5" style="stroke:#000000"/> -<circle cx="223" cy="265" r="0.5" style="stroke:#000000"/> -<circle cx="244" cy="253" r="0.5" style="stroke:#000000"/> -<circle cx="174" cy="346" r="0.5" style="stroke:#000000"/> -<circle cx="373" cy="334" r="0.5" style="stroke:#000000"/> -<circle cx="292" cy="82" r="0.5" style="stroke:#000000"/> -<circle cx="240" cy="388" r="0.5" style="stroke:#000000"/> -<circle cx="263" cy="225" r="0.5" style="stroke:#000000"/> -<circle cx="252" cy="207" r="0.5" style="stroke:#000000"/> -<circle cx="233" cy="287" r="0.5" style="stroke:#000000"/> -<circle cx="234" cy="245" r="0.5" style="stroke:#000000"/> -<circle cx="285" cy="264" r="0.5" style="stroke:#000000"/> -<circle cx="176" cy="259" r="0.5" style="stroke:#000000"/> -<circle cx="284" cy="256" r="0.5" style="stroke:#000000"/> -<circle cx="233" cy="258" r="0.5" style="stroke:#000000"/> -<circle cx="108" cy="336" r="0.5" style="stroke:#000000"/> -<circle cx="379" cy="402" r="0.5" style="stroke:#000000"/> -<circle cx="260" cy="256" r="0.5" style="stroke:#000000"/> -<circle cx="232" cy="265" r="0.5" style="stroke:#000000"/> -<circle cx="432" cy="286" r="0.5" style="stroke:#000000"/> -<circle cx="347" cy="197" r="0.5" style="stroke:#000000"/> -<circle cx="248" cy="249" r="0.5" style="stroke:#000000"/> -<circle cx="176" cy="213" r="0.5" style="stroke:#000000"/> -<circle cx="330" cy="370" r="0.5" style="stroke:#000000"/> -<circle cx="249" cy="253" r="0.5" style="stroke:#000000"/> -<circle cx="249" cy="243" r="0.5" style="stroke:#000000"/> -<circle cx="119" cy="320" r="0.5" style="stroke:#000000"/> -<circle cx="280" cy="263" r="0.5" style="stroke:#000000"/> -<circle cx="317" cy="287" r="0.5" style="stroke:#000000"/> -<circle cx="304" cy="209" r="0.5" style="stroke:#000000"/> -<circle cx="315" cy="193" r="0.5" style="stroke:#000000"/> -<circle cx="304" cy="109" r="0.5" style="stroke:#000000"/> -<circle cx="119" cy="179" r="0.5" style="stroke:#000000"/> -<circle cx="188" cy="215" r="0.5" style="stroke:#000000"/> -<circle cx="263" cy="218" r="0.5" style="stroke:#000000"/> -<circle cx="196" cy="228" r="0.5" style="stroke:#000000"/> -<circle cx="371" cy="307" r="0.5" style="stroke:#000000"/> -<circle cx="285" cy="263" r="0.5" style="stroke:#000000"/> -<circle cx="130" cy="217" r="0.5" style="stroke:#000000"/> -<circle cx="250" cy="250" r="0.5" style="stroke:#000000"/> -<circle cx="335" cy="201" r="0.5" style="stroke:#000000"/> -<circle cx="211" cy="145" r="0.5" style="stroke:#000000"/> -<circle cx="242" cy="182" r="0.5" style="stroke:#000000"/> -<circle cx="221" cy="256" r="0.5" style="stroke:#000000"/> -<circle cx="177" cy="398" r="0.5" style="stroke:#000000"/> -<circle cx="333" cy="158" r="0.5" style="stroke:#000000"/> -<circle cx="199" cy="297" r="0.5" style="stroke:#000000"/> -<circle cx="342" cy="153" r="0.5" style="stroke:#000000"/> -<circle cx="273" cy="419" r="0.5" style="stroke:#000000"/> -<circle cx="227" cy="173" r="0.5" style="stroke:#000000"/> -<circle cx="169" cy="242" r="0.5" style="stroke:#000000"/> -<circle cx="294" cy="292" r="0.5" style="stroke:#000000"/> -<circle cx="303" cy="155" r="0.5" style="stroke:#000000"/> -<circle cx="211" cy="124" r="0.5" style="stroke:#000000"/> -<circle cx="253" cy="116" r="0.5" style="stroke:#000000"/> -<circle cx="254" cy="246" r="0.5" style="stroke:#000000"/> -<circle cx="377" cy="388" r="0.5" style="stroke:#000000"/> -<circle cx="130" cy="285" r="0.5" style="stroke:#000000"/> -<circle cx="273" cy="215" r="0.5" style="stroke:#000000"/> -<circle cx="438" cy="229" r="0.5" style="stroke:#000000"/> -<circle cx="446" cy="216" r="0.5" style="stroke:#000000"/> -<circle cx="242" cy="238" r="0.5" style="stroke:#000000"/> -<circle cx="224" cy="229" r="0.5" style="stroke:#000000"/> -<circle cx="133" cy="181" r="0.5" style="stroke:#000000"/> -<circle cx="270" cy="222" r="0.5" style="stroke:#000000"/> -<circle cx="275" cy="237" r="0.5" style="stroke:#000000"/> -<circle cx="160" cy="202" r="0.5" style="stroke:#000000"/> -<circle cx="416" cy="302" r="0.5" style="stroke:#000000"/> -<circle cx="366" cy="244" r="0.5" style="stroke:#000000"/> -<circle cx="279" cy="186" r="0.5" style="stroke:#000000"/> -<circle cx="134" cy="353" r="0.5" style="stroke:#000000"/> -<circle cx="99" cy="159" r="0.5" style="stroke:#000000"/> -<circle cx="177" cy="198" r="0.5" style="stroke:#000000"/> -<circle cx="239" cy="253" r="0.5" style="stroke:#000000"/> -<circle cx="298" cy="190" r="0.5" style="stroke:#000000"/> -<circle cx="213" cy="70" r="0.5" style="stroke:#000000"/> -<circle cx="122" cy="236" r="0.5" style="stroke:#000000"/> -<circle cx="318" cy="92" r="0.5" style="stroke:#000000"/> -<circle cx="196" cy="362" r="0.5" style="stroke:#000000"/> -<circle cx="234" cy="235" r="0.5" style="stroke:#000000"/> -<circle cx="250" cy="250" r="0.5" style="stroke:#000000"/> -<circle cx="321" cy="367" r="0.5" style="stroke:#000000"/> -<circle cx="251" cy="249" r="0.5" style="stroke:#000000"/> -<circle cx="141" cy="154" r="0.5" style="stroke:#000000"/> -<circle cx="152" cy="308" r="0.5" style="stroke:#000000"/> -<circle cx="110" cy="178" r="0.5" style="stroke:#000000"/> -<circle cx="229" cy="216" r="0.5" style="stroke:#000000"/> -<circle cx="421" cy="250" r="0.5" style="stroke:#000000"/> -<circle cx="215" cy="269" r="0.5" style="stroke:#000000"/> -<circle cx="131" cy="157" r="0.5" style="stroke:#000000"/> -<circle cx="238" cy="245" r="0.5" style="stroke:#000000"/> -<circle cx="264" cy="224" r="0.5" style="stroke:#000000"/> -<circle cx="79" cy="327" r="0.5" style="stroke:#000000"/> -<circle cx="424" cy="266" r="0.5" style="stroke:#000000"/> -<circle cx="237" cy="232" r="0.5" style="stroke:#000000"/> -<circle cx="142" cy="253" r="0.5" style="stroke:#000000"/> -<circle cx="156" cy="355" r="0.5" style="stroke:#000000"/> -<circle cx="239" cy="239" r="0.5" style="stroke:#000000"/> -<circle cx="238" cy="322" r="0.5" style="stroke:#000000"/> -<circle cx="177" cy="396" r="0.5" style="stroke:#000000"/> -<circle cx="310" cy="152" r="0.5" style="stroke:#000000"/> -<circle cx="83" cy="354" r="0.5" style="stroke:#000000"/> -<circle cx="236" cy="434" r="0.5" style="stroke:#000000"/> -<circle cx="439" cy="287" r="0.5" style="stroke:#000000"/> -<circle cx="173" cy="232" r="0.5" style="stroke:#000000"/> -<circle cx="181" cy="143" r="0.5" style="stroke:#000000"/> -<circle cx="404" cy="232" r="0.5" style="stroke:#000000"/> -<circle cx="173" cy="177" r="0.5" style="stroke:#000000"/> -<circle cx="362" cy="161" r="0.5" style="stroke:#000000"/> -<circle cx="87" cy="81" r="0.5" style="stroke:#000000"/> -<circle cx="124" cy="106" r="0.5" style="stroke:#000000"/> -<circle cx="76" cy="141" r="0.5" style="stroke:#000000"/> -<circle cx="65" cy="166" r="0.5" style="stroke:#000000"/> -<circle cx="93" cy="103" r="0.5" style="stroke:#000000"/> -<circle cx="107" cy="159" r="0.5" style="stroke:#000000"/> -<circle cx="140" cy="80" r="0.5" style="stroke:#000000"/> -<circle cx="134" cy="81" r="0.5" style="stroke:#000000"/> -<circle cx="76" cy="60" r="0.5" style="stroke:#000000"/> -<circle cx="123" cy="123" r="0.5" style="stroke:#000000"/> -<circle cx="139" cy="64" r="0.5" style="stroke:#000000"/> -<circle cx="100" cy="100" r="0.5" style="stroke:#000000"/> -<circle cx="110" cy="96" r="0.5" style="stroke:#000000"/> -<circle cx="110" cy="159" r="0.5" style="stroke:#000000"/> -<circle cx="67" cy="117" r="0.5" style="stroke:#000000"/> -<circle cx="140" cy="159" r="0.5" style="stroke:#000000"/> -<circle cx="103" cy="101" r="0.5" style="stroke:#000000"/> -<circle cx="99" cy="88" r="0.5" style="stroke:#000000"/> -<circle cx="100" cy="101" r="0.5" style="stroke:#000000"/> -<circle cx="76" cy="89" r="0.5" style="stroke:#000000"/> -<circle cx="37" cy="80" r="0.5" style="stroke:#000000"/> -<circle cx="62" cy="78" r="0.5" style="stroke:#000000"/> -<circle cx="115" cy="34" r="0.5" style="stroke:#000000"/> -<circle cx="36" cy="79" r="0.5" style="stroke:#000000"/> -<circle cx="60" cy="70" r="0.5" style="stroke:#000000"/> -<circle cx="137" cy="124" r="0.5" style="stroke:#000000"/> -<circle cx="156" cy="144" r="0.5" style="stroke:#000000"/> -<circle cx="111" cy="124" r="0.5" style="stroke:#000000"/> -<circle cx="137" cy="168" r="0.5" style="stroke:#000000"/> -<circle cx="110" cy="55" r="0.5" style="stroke:#000000"/> -<circle cx="75" cy="111" r="0.5" style="stroke:#000000"/> -<circle cx="137" cy="171" r="0.5" style="stroke:#000000"/> -<circle cx="102" cy="68" r="0.5" style="stroke:#000000"/> -<circle cx="63" cy="131" r="0.5" style="stroke:#000000"/> -<circle cx="122" cy="78" r="0.5" style="stroke:#000000"/> -<circle cx="126" cy="104" r="0.5" style="stroke:#000000"/> -<circle cx="86" cy="144" r="0.5" style="stroke:#000000"/> -<circle cx="123" cy="122" r="0.5" style="stroke:#000000"/> -<circle cx="92" cy="88" r="0.5" style="stroke:#000000"/> -<circle cx="91" cy="140" r="0.5" style="stroke:#000000"/> -<circle cx="91" cy="78" r="0.5" style="stroke:#000000"/> -<circle cx="126" cy="112" r="0.5" style="stroke:#000000"/> -<circle cx="84" cy="78" r="0.5" style="stroke:#000000"/> -<circle cx="147" cy="87" r="0.5" style="stroke:#000000"/> -<circle cx="70" cy="85" r="0.5" style="stroke:#000000"/> -<circle cx="47" cy="77" r="0.5" style="stroke:#000000"/> -<circle cx="127" cy="46" r="0.5" style="stroke:#000000"/> -<circle cx="100" cy="100" r="0.5" style="stroke:#000000"/> -<circle cx="142" cy="163" r="0.5" style="stroke:#000000"/> -<circle cx="101" cy="99" r="0.5" style="stroke:#000000"/> -<circle cx="88" cy="119" r="0.5" style="stroke:#000000"/> -<circle cx="87" cy="93" r="0.5" style="stroke:#000000"/> -<circle cx="113" cy="88" r="0.5" style="stroke:#000000"/> -<circle cx="96" cy="83" r="0.5" style="stroke:#000000"/> -<circle cx="106" cy="102" r="0.5" style="stroke:#000000"/> -<circle cx="124" cy="130" r="0.5" style="stroke:#000000"/> -<circle cx="80" cy="99" r="0.5" style="stroke:#000000"/> -<circle cx="155" cy="144" r="0.5" style="stroke:#000000"/> -<circle cx="59" cy="74" r="0.5" style="stroke:#000000"/> -<circle cx="50" cy="94" r="0.5" style="stroke:#000000"/> -<circle cx="103" cy="120" r="0.5" style="stroke:#000000"/> -<circle cx="102" cy="100" r="0.5" style="stroke:#000000"/> -<circle cx="20" cy="98" r="0.5" style="stroke:#000000"/> -<circle cx="92" cy="136" r="0.5" style="stroke:#000000"/> -<circle cx="75" cy="115" r="0.5" style="stroke:#000000"/> -<circle cx="75" cy="74" r="0.5" style="stroke:#000000"/> -<circle cx="146" cy="165" r="0.5" style="stroke:#000000"/> -<circle cx="73" cy="56" r="0.5" style="stroke:#000000"/> -<circle cx="122" cy="45" r="0.5" style="stroke:#000000"/> -<circle cx="115" cy="59" r="0.5" style="stroke:#000000"/> -<circle cx="160" cy="97" r="0.5" style="stroke:#000000"/> -<circle cx="116" cy="161" r="0.5" style="stroke:#000000"/> -<circle cx="139" cy="63" r="0.5" style="stroke:#000000"/> -<circle cx="115" cy="57" r="0.5" style="stroke:#000000"/> -<circle cx="89" cy="94" r="0.5" style="stroke:#000000"/> -<circle cx="72" cy="64" r="0.5" style="stroke:#000000"/> -<circle cx="53" cy="99" r="0.5" style="stroke:#000000"/> -<circle cx="95" cy="110" r="0.5" style="stroke:#000000"/> -<circle cx="99" cy="100" r="0.5" style="stroke:#000000"/> -<circle cx="81" cy="158" r="0.5" style="stroke:#000000"/> -<circle cx="77" cy="46" r="0.5" style="stroke:#000000"/> -<circle cx="104" cy="118" r="0.5" style="stroke:#000000"/> -<circle cx="98" cy="160" r="0.5" style="stroke:#000000"/> -<circle cx="102" cy="121" r="0.5" style="stroke:#000000"/> -<circle cx="81" cy="88" r="0.5" style="stroke:#000000"/> -<circle cx="145" cy="163" r="0.5" style="stroke:#000000"/> -<circle cx="110" cy="94" r="0.5" style="stroke:#000000"/> -<circle cx="72" cy="122" r="0.5" style="stroke:#000000"/> -<circle cx="103" cy="96" r="0.5" style="stroke:#000000"/> -<circle cx="101" cy="95" r="0.5" style="stroke:#000000"/> -<circle cx="95" cy="163" r="0.5" style="stroke:#000000"/> -<circle cx="99" cy="101" r="0.5" style="stroke:#000000"/> -<circle cx="89" cy="106" r="0.5" style="stroke:#000000"/> -<circle cx="98" cy="101" r="0.5" style="stroke:#000000"/> -<circle cx="70" cy="138" r="0.5" style="stroke:#000000"/> -<circle cx="149" cy="134" r="0.5" style="stroke:#000000"/> -<circle cx="117" cy="33" r="0.5" style="stroke:#000000"/> -<circle cx="96" cy="155" r="0.5" style="stroke:#000000"/> -<circle cx="105" cy="90" r="0.5" style="stroke:#000000"/> -<circle cx="101" cy="83" r="0.5" style="stroke:#000000"/> -<circle cx="93" cy="115" r="0.5" style="stroke:#000000"/> -<circle cx="94" cy="98" r="0.5" style="stroke:#000000"/> -<circle cx="114" cy="105" r="0.5" style="stroke:#000000"/> -<circle cx="70" cy="103" r="0.5" style="stroke:#000000"/> -<circle cx="114" cy="103" r="0.5" style="stroke:#000000"/> -<circle cx="93" cy="103" r="0.5" style="stroke:#000000"/> -<circle cx="43" cy="135" r="0.5" style="stroke:#000000"/> -<circle cx="152" cy="161" r="0.5" style="stroke:#000000"/> -<circle cx="104" cy="102" r="0.5" style="stroke:#000000"/> -<circle cx="93" cy="106" r="0.5" style="stroke:#000000"/> -<circle cx="173" cy="115" r="0.5" style="stroke:#000000"/> -<circle cx="139" cy="79" r="0.5" style="stroke:#000000"/> -<circle cx="99" cy="99" r="0.5" style="stroke:#000000"/> -<circle cx="70" cy="85" r="0.5" style="stroke:#000000"/> -<circle cx="132" cy="148" r="0.5" style="stroke:#000000"/> -<circle cx="99" cy="101" r="0.5" style="stroke:#000000"/> -<circle cx="100" cy="97" r="0.5" style="stroke:#000000"/> -<circle cx="47" cy="128" r="0.5" style="stroke:#000000"/> -<circle cx="112" cy="105" r="0.5" style="stroke:#000000"/> -<circle cx="127" cy="115" r="0.5" style="stroke:#000000"/> -<circle cx="122" cy="84" r="0.5" style="stroke:#000000"/> -<circle cx="126" cy="77" r="0.5" style="stroke:#000000"/> -<circle cx="121" cy="44" r="0.5" style="stroke:#000000"/> -<circle cx="48" cy="72" r="0.5" style="stroke:#000000"/> -<circle cx="75" cy="86" r="0.5" style="stroke:#000000"/> -<circle cx="105" cy="87" r="0.5" style="stroke:#000000"/> -<circle cx="79" cy="91" r="0.5" style="stroke:#000000"/> -<circle cx="148" cy="123" r="0.5" style="stroke:#000000"/> -<circle cx="114" cy="105" r="0.5" style="stroke:#000000"/> -<circle cx="52" cy="87" r="0.5" style="stroke:#000000"/> -<circle cx="100" cy="100" r="0.5" style="stroke:#000000"/> -<circle cx="134" cy="80" r="0.5" style="stroke:#000000"/> -<circle cx="84" cy="58" r="0.5" style="stroke:#000000"/> -<circle cx="97" cy="73" r="0.5" style="stroke:#000000"/> -<circle cx="88" cy="102" r="0.5" style="stroke:#000000"/> -<circle cx="71" cy="159" r="0.5" style="stroke:#000000"/> -<circle cx="133" cy="63" r="0.5" style="stroke:#000000"/> -<circle cx="80" cy="119" r="0.5" style="stroke:#000000"/> -<circle cx="137" cy="61" r="0.5" style="stroke:#000000"/> -<circle cx="109" cy="168" r="0.5" style="stroke:#000000"/> -<circle cx="91" cy="69" r="0.5" style="stroke:#000000"/> -<circle cx="68" cy="97" r="0.5" style="stroke:#000000"/> -<circle cx="117" cy="117" r="0.5" style="stroke:#000000"/> -<circle cx="121" cy="62" r="0.5" style="stroke:#000000"/> -<circle cx="84" cy="50" r="0.5" style="stroke:#000000"/> -<circle cx="101" cy="46" r="0.5" style="stroke:#000000"/> -<circle cx="102" cy="98" r="0.5" style="stroke:#000000"/> -<circle cx="151" cy="155" r="0.5" style="stroke:#000000"/> -<circle cx="52" cy="114" r="0.5" style="stroke:#000000"/> -<circle cx="109" cy="86" r="0.5" style="stroke:#000000"/> -<circle cx="175" cy="91" r="0.5" style="stroke:#000000"/> -<circle cx="178" cy="87" r="0.5" style="stroke:#000000"/> -<circle cx="97" cy="95" r="0.5" style="stroke:#000000"/> -<circle cx="90" cy="92" r="0.5" style="stroke:#000000"/> -<circle cx="53" cy="72" r="0.5" style="stroke:#000000"/> -<circle cx="108" cy="89" r="0.5" style="stroke:#000000"/> -<circle cx="110" cy="95" r="0.5" style="stroke:#000000"/> -<circle cx="64" cy="81" r="0.5" style="stroke:#000000"/> -<circle cx="166" cy="121" r="0.5" style="stroke:#000000"/> -<circle cx="146" cy="97" r="0.5" style="stroke:#000000"/> -<circle cx="112" cy="74" r="0.5" style="stroke:#000000"/> -<circle cx="54" cy="141" r="0.5" style="stroke:#000000"/> -<circle cx="40" cy="64" r="0.5" style="stroke:#000000"/> -<circle cx="71" cy="79" r="0.5" style="stroke:#000000"/> -<circle cx="96" cy="101" r="0.5" style="stroke:#000000"/> -<circle cx="119" cy="76" r="0.5" style="stroke:#000000"/> -<circle cx="85" cy="28" r="0.5" style="stroke:#000000"/> -<circle cx="49" cy="94" r="0.5" style="stroke:#000000"/> -<circle cx="127" cy="37" r="0.5" style="stroke:#000000"/> -<circle cx="78" cy="145" r="0.5" style="stroke:#000000"/> -<circle cx="94" cy="94" r="0.5" style="stroke:#000000"/> -<circle cx="100" cy="100" r="0.5" style="stroke:#000000"/> -<circle cx="128" cy="147" r="0.5" style="stroke:#000000"/> -<circle cx="101" cy="100" r="0.5" style="stroke:#000000"/> -<circle cx="56" cy="62" r="0.5" style="stroke:#000000"/> -<circle cx="61" cy="123" r="0.5" style="stroke:#000000"/> -<circle cx="44" cy="71" r="0.5" style="stroke:#000000"/> -<circle cx="92" cy="86" r="0.5" style="stroke:#000000"/> -<circle cx="169" cy="100" r="0.5" style="stroke:#000000"/> -<circle cx="86" cy="107" r="0.5" style="stroke:#000000"/> -<circle cx="52" cy="63" r="0.5" style="stroke:#000000"/> -<circle cx="95" cy="98" r="0.5" style="stroke:#000000"/> -<circle cx="106" cy="89" r="0.5" style="stroke:#000000"/> -<circle cx="32" cy="131" r="0.5" style="stroke:#000000"/> -<circle cx="170" cy="106" r="0.5" style="stroke:#000000"/> -<circle cx="95" cy="93" r="0.5" style="stroke:#000000"/> -<circle cx="57" cy="101" r="0.5" style="stroke:#000000"/> -<circle cx="62" cy="142" r="0.5" style="stroke:#000000"/> -<circle cx="95" cy="95" r="0.5" style="stroke:#000000"/> -<circle cx="95" cy="129" r="0.5" style="stroke:#000000"/> -<circle cx="71" cy="158" r="0.5" style="stroke:#000000"/> -<circle cx="124" cy="61" r="0.5" style="stroke:#000000"/> -<circle cx="33" cy="142" r="0.5" style="stroke:#000000"/> -<circle cx="94" cy="174" r="0.5" style="stroke:#000000"/> -<circle cx="176" cy="115" r="0.5" style="stroke:#000000"/> -<circle cx="69" cy="93" r="0.5" style="stroke:#000000"/> -<circle cx="73" cy="57" r="0.5" style="stroke:#000000"/> -<circle cx="162" cy="93" r="0.5" style="stroke:#000000"/> -<circle cx="69" cy="71" r="0.5" style="stroke:#000000"/> -<circle cx="145" cy="64" r="0.5" style="stroke:#000000"/> -<circle cx="145" cy="293" r="0.5" style="stroke:#000000"/> -<circle cx="159" cy="302" r="0.5" style="stroke:#000000"/> -<circle cx="141" cy="315" r="0.5" style="stroke:#000000"/> -<circle cx="137" cy="325" r="0.5" style="stroke:#000000"/> -<circle cx="147" cy="301" r="0.5" style="stroke:#000000"/> -<circle cx="152" cy="322" r="0.5" style="stroke:#000000"/> -<circle cx="165" cy="293" r="0.5" style="stroke:#000000"/> -<circle cx="163" cy="293" r="0.5" style="stroke:#000000"/> -<circle cx="141" cy="285" r="0.5" style="stroke:#000000"/> -<circle cx="159" cy="309" r="0.5" style="stroke:#000000"/> -<circle cx="164" cy="287" r="0.5" style="stroke:#000000"/> -<circle cx="150" cy="300" r="0.5" style="stroke:#000000"/> -<circle cx="154" cy="299" r="0.5" style="stroke:#000000"/> -<circle cx="154" cy="322" r="0.5" style="stroke:#000000"/> -<circle cx="138" cy="306" r="0.5" style="stroke:#000000"/> -<circle cx="165" cy="322" r="0.5" style="stroke:#000000"/> -<circle cx="151" cy="301" r="0.5" style="stroke:#000000"/> -<circle cx="150" cy="295" r="0.5" style="stroke:#000000"/> -<circle cx="150" cy="300" r="0.5" style="stroke:#000000"/> -<circle cx="141" cy="296" r="0.5" style="stroke:#000000"/> -<circle cx="126" cy="292" r="0.5" style="stroke:#000000"/> -<circle cx="136" cy="292" r="0.5" style="stroke:#000000"/> -<circle cx="156" cy="275" r="0.5" style="stroke:#000000"/> -<circle cx="126" cy="292" r="0.5" style="stroke:#000000"/> -<circle cx="135" cy="289" r="0.5" style="stroke:#000000"/> -<circle cx="164" cy="309" r="0.5" style="stroke:#000000"/> -<circle cx="171" cy="316" r="0.5" style="stroke:#000000"/> -<circle cx="154" cy="309" r="0.5" style="stroke:#000000"/> -<circle cx="164" cy="326" r="0.5" style="stroke:#000000"/> -<circle cx="154" cy="283" r="0.5" style="stroke:#000000"/> -<circle cx="141" cy="304" r="0.5" style="stroke:#000000"/> -<circle cx="164" cy="326" r="0.5" style="stroke:#000000"/> -<circle cx="151" cy="288" r="0.5" style="stroke:#000000"/> -<circle cx="136" cy="312" r="0.5" style="stroke:#000000"/> -<circle cx="158" cy="292" r="0.5" style="stroke:#000000"/> -<circle cx="160" cy="302" r="0.5" style="stroke:#000000"/> -<circle cx="145" cy="317" r="0.5" style="stroke:#000000"/> -<circle cx="158" cy="308" r="0.5" style="stroke:#000000"/> -<circle cx="147" cy="295" r="0.5" style="stroke:#000000"/> -<circle cx="147" cy="315" r="0.5" style="stroke:#000000"/> -<circle cx="147" cy="292" r="0.5" style="stroke:#000000"/> -<circle cx="160" cy="304" r="0.5" style="stroke:#000000"/> -<circle cx="144" cy="292" r="0.5" style="stroke:#000000"/> -<circle cx="168" cy="295" r="0.5" style="stroke:#000000"/> -<circle cx="139" cy="294" r="0.5" style="stroke:#000000"/> -<circle cx="130" cy="292" r="0.5" style="stroke:#000000"/> -<circle cx="160" cy="280" r="0.5" style="stroke:#000000"/> -<circle cx="150" cy="300" r="0.5" style="stroke:#000000"/> -<circle cx="166" cy="323" r="0.5" style="stroke:#000000"/> -<circle cx="150" cy="299" r="0.5" style="stroke:#000000"/> -<circle cx="145" cy="307" r="0.5" style="stroke:#000000"/> -<circle cx="145" cy="297" r="0.5" style="stroke:#000000"/> -<circle cx="155" cy="296" r="0.5" style="stroke:#000000"/> -<circle cx="148" cy="294" r="0.5" style="stroke:#000000"/> -<circle cx="152" cy="301" r="0.5" style="stroke:#000000"/> -<circle cx="159" cy="311" r="0.5" style="stroke:#000000"/> -<circle cx="142" cy="300" r="0.5" style="stroke:#000000"/> -<circle cx="171" cy="317" r="0.5" style="stroke:#000000"/> -<circle cx="135" cy="290" r="0.5" style="stroke:#000000"/> -<circle cx="131" cy="298" r="0.5" style="stroke:#000000"/> -<circle cx="151" cy="307" r="0.5" style="stroke:#000000"/> -<circle cx="151" cy="300" r="0.5" style="stroke:#000000"/> -<circle cx="120" cy="299" r="0.5" style="stroke:#000000"/> -<circle cx="147" cy="314" r="0.5" style="stroke:#000000"/> -<circle cx="141" cy="305" r="0.5" style="stroke:#000000"/> -<circle cx="141" cy="290" r="0.5" style="stroke:#000000"/> -<circle cx="167" cy="324" r="0.5" style="stroke:#000000"/> -<circle cx="140" cy="283" r="0.5" style="stroke:#000000"/> -<circle cx="158" cy="279" r="0.5" style="stroke:#000000"/> -<circle cx="155" cy="284" r="0.5" style="stroke:#000000"/> -<circle cx="172" cy="299" r="0.5" style="stroke:#000000"/> -<circle cx="156" cy="323" r="0.5" style="stroke:#000000"/> -<circle cx="164" cy="286" r="0.5" style="stroke:#000000"/> -<circle cx="156" cy="284" r="0.5" style="stroke:#000000"/> -<circle cx="146" cy="298" r="0.5" style="stroke:#000000"/> -<circle cx="140" cy="286" r="0.5" style="stroke:#000000"/> -<circle cx="133" cy="300" r="0.5" style="stroke:#000000"/> -<circle cx="148" cy="304" r="0.5" style="stroke:#000000"/> -<circle cx="149" cy="300" r="0.5" style="stroke:#000000"/> -<circle cx="143" cy="322" r="0.5" style="stroke:#000000"/> -<circle cx="141" cy="280" r="0.5" style="stroke:#000000"/> -<circle cx="152" cy="307" r="0.5" style="stroke:#000000"/> -<circle cx="149" cy="322" r="0.5" style="stroke:#000000"/> -<circle cx="151" cy="308" r="0.5" style="stroke:#000000"/> -<circle cx="143" cy="296" r="0.5" style="stroke:#000000"/> -<circle cx="167" cy="323" r="0.5" style="stroke:#000000"/> -<circle cx="154" cy="298" r="0.5" style="stroke:#000000"/> -<circle cx="139" cy="308" r="0.5" style="stroke:#000000"/> -<circle cx="151" cy="299" r="0.5" style="stroke:#000000"/> -<circle cx="150" cy="298" r="0.5" style="stroke:#000000"/> -<circle cx="148" cy="324" r="0.5" style="stroke:#000000"/> -<circle cx="150" cy="301" r="0.5" style="stroke:#000000"/> -<circle cx="146" cy="302" r="0.5" style="stroke:#000000"/> -<circle cx="149" cy="300" r="0.5" style="stroke:#000000"/> -<circle cx="139" cy="314" r="0.5" style="stroke:#000000"/> -<circle cx="168" cy="313" r="0.5" style="stroke:#000000"/> -<circle cx="156" cy="275" r="0.5" style="stroke:#000000"/> -<circle cx="148" cy="321" r="0.5" style="stroke:#000000"/> -<circle cx="152" cy="296" r="0.5" style="stroke:#000000"/> -<circle cx="150" cy="294" r="0.5" style="stroke:#000000"/> -<circle cx="147" cy="305" r="0.5" style="stroke:#000000"/> -<circle cx="148" cy="299" r="0.5" style="stroke:#000000"/> -<circle cx="155" cy="302" r="0.5" style="stroke:#000000"/> -<circle cx="139" cy="301" r="0.5" style="stroke:#000000"/> -<circle cx="155" cy="301" r="0.5" style="stroke:#000000"/> -<circle cx="147" cy="301" r="0.5" style="stroke:#000000"/> -<circle cx="129" cy="313" r="0.5" style="stroke:#000000"/> -<circle cx="169" cy="323" r="0.5" style="stroke:#000000"/> -<circle cx="151" cy="301" r="0.5" style="stroke:#000000"/> -<circle cx="147" cy="302" r="0.5" style="stroke:#000000"/> -<circle cx="177" cy="305" r="0.5" style="stroke:#000000"/> -<circle cx="165" cy="292" r="0.5" style="stroke:#000000"/> -<circle cx="150" cy="300" r="0.5" style="stroke:#000000"/> -<circle cx="139" cy="294" r="0.5" style="stroke:#000000"/> -<circle cx="162" cy="318" r="0.5" style="stroke:#000000"/> -<circle cx="150" cy="300" r="0.5" style="stroke:#000000"/> -<circle cx="150" cy="299" r="0.5" style="stroke:#000000"/> -<circle cx="130" cy="310" r="0.5" style="stroke:#000000"/> -<circle cx="155" cy="302" r="0.5" style="stroke:#000000"/> -<circle cx="160" cy="306" r="0.5" style="stroke:#000000"/> -<circle cx="158" cy="294" r="0.5" style="stroke:#000000"/> -<circle cx="160" cy="291" r="0.5" style="stroke:#000000"/> -<circle cx="158" cy="279" r="0.5" style="stroke:#000000"/> -<circle cx="130" cy="289" r="0.5" style="stroke:#000000"/> -<circle cx="141" cy="295" r="0.5" style="stroke:#000000"/> -<circle cx="152" cy="295" r="0.5" style="stroke:#000000"/> -<circle cx="142" cy="297" r="0.5" style="stroke:#000000"/> -<circle cx="168" cy="309" r="0.5" style="stroke:#000000"/> -<circle cx="155" cy="302" r="0.5" style="stroke:#000000"/> -<circle cx="132" cy="295" r="0.5" style="stroke:#000000"/> -<circle cx="150" cy="300" r="0.5" style="stroke:#000000"/> -<circle cx="163" cy="293" r="0.5" style="stroke:#000000"/> -<circle cx="144" cy="284" r="0.5" style="stroke:#000000"/> -<circle cx="149" cy="290" r="0.5" style="stroke:#000000"/> -<circle cx="146" cy="301" r="0.5" style="stroke:#000000"/> -<circle cx="139" cy="322" r="0.5" style="stroke:#000000"/> -<circle cx="163" cy="286" r="0.5" style="stroke:#000000"/> -<circle cx="142" cy="307" r="0.5" style="stroke:#000000"/> -<circle cx="164" cy="286" r="0.5" style="stroke:#000000"/> -<circle cx="153" cy="325" r="0.5" style="stroke:#000000"/> -<circle cx="147" cy="289" r="0.5" style="stroke:#000000"/> -<circle cx="138" cy="299" r="0.5" style="stroke:#000000"/> -<circle cx="157" cy="306" r="0.5" style="stroke:#000000"/> -<circle cx="158" cy="286" r="0.5" style="stroke:#000000"/> -<circle cx="144" cy="281" r="0.5" style="stroke:#000000"/> -<circle cx="150" cy="280" r="0.5" style="stroke:#000000"/> -<circle cx="151" cy="299" r="0.5" style="stroke:#000000"/> -<circle cx="169" cy="321" r="0.5" style="stroke:#000000"/> -<circle cx="132" cy="305" r="0.5" style="stroke:#000000"/> -<circle cx="153" cy="295" r="0.5" style="stroke:#000000"/> -<circle cx="178" cy="297" r="0.5" style="stroke:#000000"/> -<circle cx="179" cy="295" r="0.5" style="stroke:#000000"/> -<circle cx="149" cy="298" r="0.5" style="stroke:#000000"/> -<circle cx="146" cy="297" r="0.5" style="stroke:#000000"/> -<circle cx="132" cy="290" r="0.5" style="stroke:#000000"/> -<circle cx="153" cy="296" r="0.5" style="stroke:#000000"/> -<circle cx="154" cy="298" r="0.5" style="stroke:#000000"/> -<circle cx="136" cy="293" r="0.5" style="stroke:#000000"/> -<circle cx="175" cy="308" r="0.5" style="stroke:#000000"/> -<circle cx="167" cy="299" r="0.5" style="stroke:#000000"/> -<circle cx="154" cy="290" r="0.5" style="stroke:#000000"/> -<circle cx="133" cy="316" r="0.5" style="stroke:#000000"/> -<circle cx="127" cy="286" r="0.5" style="stroke:#000000"/> -<circle cx="139" cy="292" r="0.5" style="stroke:#000000"/> -<circle cx="148" cy="300" r="0.5" style="stroke:#000000"/> -<circle cx="157" cy="291" r="0.5" style="stroke:#000000"/> -<circle cx="144" cy="273" r="0.5" style="stroke:#000000"/> -<circle cx="131" cy="298" r="0.5" style="stroke:#000000"/> -<circle cx="160" cy="276" r="0.5" style="stroke:#000000"/> -<circle cx="142" cy="317" r="0.5" style="stroke:#000000"/> -<circle cx="148" cy="298" r="0.5" style="stroke:#000000"/> -<circle cx="150" cy="300" r="0.5" style="stroke:#000000"/> -<circle cx="161" cy="318" r="0.5" style="stroke:#000000"/> -<circle cx="150" cy="300" r="0.5" style="stroke:#000000"/> -<circle cx="134" cy="286" r="0.5" style="stroke:#000000"/> -<circle cx="135" cy="309" r="0.5" style="stroke:#000000"/> -<circle cx="129" cy="289" r="0.5" style="stroke:#000000"/> -<circle cx="147" cy="295" r="0.5" style="stroke:#000000"/> -<circle cx="176" cy="300" r="0.5" style="stroke:#000000"/> -<circle cx="145" cy="303" r="0.5" style="stroke:#000000"/> -<circle cx="132" cy="286" r="0.5" style="stroke:#000000"/> -<circle cx="148" cy="299" r="0.5" style="stroke:#000000"/> -<circle cx="152" cy="296" r="0.5" style="stroke:#000000"/> -<circle cx="124" cy="311" r="0.5" style="stroke:#000000"/> -<circle cx="176" cy="302" r="0.5" style="stroke:#000000"/> -<circle cx="148" cy="297" r="0.5" style="stroke:#000000"/> -<circle cx="134" cy="301" r="0.5" style="stroke:#000000"/> -<circle cx="136" cy="316" r="0.5" style="stroke:#000000"/> -<circle cx="148" cy="298" r="0.5" style="stroke:#000000"/> -<circle cx="148" cy="311" r="0.5" style="stroke:#000000"/> -<circle cx="139" cy="322" r="0.5" style="stroke:#000000"/> -<circle cx="159" cy="285" r="0.5" style="stroke:#000000"/> -<circle cx="125" cy="316" r="0.5" style="stroke:#000000"/> -<circle cx="148" cy="328" r="0.5" style="stroke:#000000"/> -<circle cx="178" cy="306" r="0.5" style="stroke:#000000"/> -<circle cx="138" cy="297" r="0.5" style="stroke:#000000"/> -<circle cx="140" cy="284" r="0.5" style="stroke:#000000"/> -<circle cx="173" cy="297" r="0.5" style="stroke:#000000"/> -<circle cx="138" cy="289" r="0.5" style="stroke:#000000"/> -<circle cx="167" cy="287" r="0.5" style="stroke:#000000"/> -<circle cx="495" cy="113" r="0.5" style="stroke:#000000"/> -<circle cx="509" cy="122" r="0.5" style="stroke:#000000"/> -<circle cx="491" cy="135" r="0.5" style="stroke:#000000"/> -<circle cx="487" cy="145" r="0.5" style="stroke:#000000"/> -<circle cx="497" cy="121" r="0.5" style="stroke:#000000"/> -<circle cx="502" cy="142" r="0.5" style="stroke:#000000"/> -<circle cx="515" cy="113" r="0.5" style="stroke:#000000"/> -<circle cx="513" cy="113" r="0.5" style="stroke:#000000"/> -<circle cx="491" cy="105" r="0.5" style="stroke:#000000"/> -<circle cx="509" cy="129" r="0.5" style="stroke:#000000"/> -<circle cx="514" cy="107" r="0.5" style="stroke:#000000"/> -<circle cx="500" cy="120" r="0.5" style="stroke:#000000"/> -<circle cx="504" cy="119" r="0.5" style="stroke:#000000"/> -<circle cx="504" cy="142" r="0.5" style="stroke:#000000"/> -<circle cx="488" cy="126" r="0.5" style="stroke:#000000"/> -<circle cx="515" cy="142" r="0.5" style="stroke:#000000"/> -<circle cx="501" cy="121" r="0.5" style="stroke:#000000"/> -<circle cx="500" cy="115" r="0.5" style="stroke:#000000"/> -<circle cx="500" cy="120" r="0.5" style="stroke:#000000"/> -<circle cx="491" cy="116" r="0.5" style="stroke:#000000"/> -<circle cx="476" cy="112" r="0.5" style="stroke:#000000"/> -<circle cx="486" cy="112" r="0.5" style="stroke:#000000"/> -<circle cx="506" cy="95" r="0.5" style="stroke:#000000"/> -<circle cx="476" cy="112" r="0.5" style="stroke:#000000"/> -<circle cx="485" cy="109" r="0.5" style="stroke:#000000"/> -<circle cx="514" cy="129" r="0.5" style="stroke:#000000"/> -<circle cx="521" cy="136" r="0.5" style="stroke:#000000"/> -<circle cx="504" cy="129" r="0.5" style="stroke:#000000"/> -<circle cx="514" cy="146" r="0.5" style="stroke:#000000"/> -<circle cx="504" cy="103" r="0.5" style="stroke:#000000"/> -<circle cx="491" cy="124" r="0.5" style="stroke:#000000"/> -<circle cx="514" cy="146" r="0.5" style="stroke:#000000"/> -<circle cx="501" cy="108" r="0.5" style="stroke:#000000"/> -<circle cx="486" cy="132" r="0.5" style="stroke:#000000"/> -<circle cx="508" cy="112" r="0.5" style="stroke:#000000"/> -<circle cx="510" cy="122" r="0.5" style="stroke:#000000"/> -<circle cx="495" cy="137" r="0.5" style="stroke:#000000"/> -<circle cx="508" cy="128" r="0.5" style="stroke:#000000"/> -<circle cx="497" cy="115" r="0.5" style="stroke:#000000"/> -<circle cx="497" cy="135" r="0.5" style="stroke:#000000"/> -<circle cx="497" cy="112" r="0.5" style="stroke:#000000"/> -<circle cx="510" cy="124" r="0.5" style="stroke:#000000"/> -<circle cx="494" cy="112" r="0.5" style="stroke:#000000"/> -<circle cx="518" cy="115" r="0.5" style="stroke:#000000"/> -<circle cx="489" cy="114" r="0.5" style="stroke:#000000"/> -<circle cx="480" cy="112" r="0.5" style="stroke:#000000"/> -<circle cx="510" cy="100" r="0.5" style="stroke:#000000"/> -<circle cx="500" cy="120" r="0.5" style="stroke:#000000"/> -<circle cx="516" cy="143" r="0.5" style="stroke:#000000"/> -<circle cx="500" cy="119" r="0.5" style="stroke:#000000"/> -<circle cx="495" cy="127" r="0.5" style="stroke:#000000"/> -<circle cx="495" cy="117" r="0.5" style="stroke:#000000"/> -<circle cx="505" cy="116" r="0.5" style="stroke:#000000"/> -<circle cx="498" cy="114" r="0.5" style="stroke:#000000"/> -<circle cx="502" cy="121" r="0.5" style="stroke:#000000"/> -<circle cx="509" cy="131" r="0.5" style="stroke:#000000"/> -<circle cx="492" cy="120" r="0.5" style="stroke:#000000"/> -<circle cx="521" cy="137" r="0.5" style="stroke:#000000"/> -<circle cx="485" cy="110" r="0.5" style="stroke:#000000"/> -<circle cx="481" cy="118" r="0.5" style="stroke:#000000"/> -<circle cx="501" cy="127" r="0.5" style="stroke:#000000"/> -<circle cx="501" cy="120" r="0.5" style="stroke:#000000"/> -<circle cx="470" cy="119" r="0.5" style="stroke:#000000"/> -<circle cx="497" cy="134" r="0.5" style="stroke:#000000"/> -<circle cx="491" cy="125" r="0.5" style="stroke:#000000"/> -<circle cx="491" cy="110" r="0.5" style="stroke:#000000"/> -<circle cx="517" cy="144" r="0.5" style="stroke:#000000"/> -<circle cx="490" cy="103" r="0.5" style="stroke:#000000"/> -<circle cx="508" cy="99" r="0.5" style="stroke:#000000"/> -<circle cx="505" cy="104" r="0.5" style="stroke:#000000"/> -<circle cx="522" cy="119" r="0.5" style="stroke:#000000"/> -<circle cx="506" cy="143" r="0.5" style="stroke:#000000"/> -<circle cx="514" cy="106" r="0.5" style="stroke:#000000"/> -<circle cx="506" cy="104" r="0.5" style="stroke:#000000"/> -<circle cx="496" cy="118" r="0.5" style="stroke:#000000"/> -<circle cx="490" cy="106" r="0.5" style="stroke:#000000"/> -<circle cx="483" cy="120" r="0.5" style="stroke:#000000"/> -<circle cx="498" cy="124" r="0.5" style="stroke:#000000"/> -<circle cx="499" cy="120" r="0.5" style="stroke:#000000"/> -<circle cx="493" cy="142" r="0.5" style="stroke:#000000"/> -<circle cx="491" cy="100" r="0.5" style="stroke:#000000"/> -<circle cx="502" cy="127" r="0.5" style="stroke:#000000"/> -<circle cx="499" cy="142" r="0.5" style="stroke:#000000"/> -<circle cx="501" cy="128" r="0.5" style="stroke:#000000"/> -<circle cx="493" cy="116" r="0.5" style="stroke:#000000"/> -<circle cx="517" cy="143" r="0.5" style="stroke:#000000"/> -<circle cx="504" cy="118" r="0.5" style="stroke:#000000"/> -<circle cx="489" cy="128" r="0.5" style="stroke:#000000"/> -<circle cx="501" cy="119" r="0.5" style="stroke:#000000"/> -<circle cx="500" cy="118" r="0.5" style="stroke:#000000"/> -<circle cx="498" cy="144" r="0.5" style="stroke:#000000"/> -<circle cx="500" cy="121" r="0.5" style="stroke:#000000"/> -<circle cx="496" cy="122" r="0.5" style="stroke:#000000"/> -<circle cx="499" cy="120" r="0.5" style="stroke:#000000"/> -<circle cx="489" cy="134" r="0.5" style="stroke:#000000"/> -<circle cx="518" cy="133" r="0.5" style="stroke:#000000"/> -<circle cx="506" cy="95" r="0.5" style="stroke:#000000"/> -<circle cx="498" cy="141" r="0.5" style="stroke:#000000"/> -<circle cx="502" cy="116" r="0.5" style="stroke:#000000"/> -<circle cx="500" cy="114" r="0.5" style="stroke:#000000"/> -<circle cx="497" cy="125" r="0.5" style="stroke:#000000"/> -<circle cx="498" cy="119" r="0.5" style="stroke:#000000"/> -<circle cx="505" cy="122" r="0.5" style="stroke:#000000"/> -<circle cx="489" cy="121" r="0.5" style="stroke:#000000"/> -<circle cx="505" cy="121" r="0.5" style="stroke:#000000"/> -<circle cx="497" cy="121" r="0.5" style="stroke:#000000"/> -<circle cx="479" cy="133" r="0.5" style="stroke:#000000"/> -<circle cx="519" cy="143" r="0.5" style="stroke:#000000"/> -<circle cx="501" cy="121" r="0.5" style="stroke:#000000"/> -<circle cx="497" cy="122" r="0.5" style="stroke:#000000"/> -<circle cx="527" cy="125" r="0.5" style="stroke:#000000"/> -<circle cx="515" cy="112" r="0.5" style="stroke:#000000"/> -<circle cx="500" cy="120" r="0.5" style="stroke:#000000"/> -<circle cx="489" cy="114" r="0.5" style="stroke:#000000"/> -<circle cx="512" cy="138" r="0.5" style="stroke:#000000"/> -<circle cx="500" cy="120" r="0.5" style="stroke:#000000"/> -<circle cx="500" cy="119" r="0.5" style="stroke:#000000"/> -<circle cx="480" cy="130" r="0.5" style="stroke:#000000"/> -<circle cx="505" cy="122" r="0.5" style="stroke:#000000"/> -<circle cx="510" cy="126" r="0.5" style="stroke:#000000"/> -<circle cx="508" cy="114" r="0.5" style="stroke:#000000"/> -<circle cx="510" cy="111" r="0.5" style="stroke:#000000"/> -<circle cx="508" cy="99" r="0.5" style="stroke:#000000"/> -<circle cx="480" cy="109" r="0.5" style="stroke:#000000"/> -<circle cx="491" cy="115" r="0.5" style="stroke:#000000"/> -<circle cx="502" cy="115" r="0.5" style="stroke:#000000"/> -<circle cx="492" cy="117" r="0.5" style="stroke:#000000"/> -<circle cx="518" cy="129" r="0.5" style="stroke:#000000"/> -<circle cx="505" cy="122" r="0.5" style="stroke:#000000"/> -<circle cx="482" cy="115" r="0.5" style="stroke:#000000"/> -<circle cx="500" cy="120" r="0.5" style="stroke:#000000"/> -<circle cx="513" cy="113" r="0.5" style="stroke:#000000"/> -<circle cx="494" cy="104" r="0.5" style="stroke:#000000"/> -<circle cx="499" cy="110" r="0.5" style="stroke:#000000"/> -<circle cx="496" cy="121" r="0.5" style="stroke:#000000"/> -<circle cx="489" cy="142" r="0.5" style="stroke:#000000"/> -<circle cx="513" cy="106" r="0.5" style="stroke:#000000"/> -<circle cx="492" cy="127" r="0.5" style="stroke:#000000"/> -<circle cx="514" cy="106" r="0.5" style="stroke:#000000"/> -<circle cx="503" cy="145" r="0.5" style="stroke:#000000"/> -<circle cx="497" cy="109" r="0.5" style="stroke:#000000"/> -<circle cx="488" cy="119" r="0.5" style="stroke:#000000"/> -<circle cx="507" cy="126" r="0.5" style="stroke:#000000"/> -<circle cx="508" cy="106" r="0.5" style="stroke:#000000"/> -<circle cx="494" cy="101" r="0.5" style="stroke:#000000"/> -<circle cx="500" cy="100" r="0.5" style="stroke:#000000"/> -<circle cx="501" cy="119" r="0.5" style="stroke:#000000"/> -<circle cx="519" cy="141" r="0.5" style="stroke:#000000"/> -<circle cx="482" cy="125" r="0.5" style="stroke:#000000"/> -<circle cx="503" cy="115" r="0.5" style="stroke:#000000"/> -<circle cx="528" cy="117" r="0.5" style="stroke:#000000"/> -<circle cx="529" cy="115" r="0.5" style="stroke:#000000"/> -<circle cx="499" cy="118" r="0.5" style="stroke:#000000"/> -<circle cx="496" cy="117" r="0.5" style="stroke:#000000"/> -<circle cx="482" cy="110" r="0.5" style="stroke:#000000"/> -<circle cx="503" cy="116" r="0.5" style="stroke:#000000"/> -<circle cx="504" cy="118" r="0.5" style="stroke:#000000"/> -<circle cx="486" cy="113" r="0.5" style="stroke:#000000"/> -<circle cx="525" cy="128" r="0.5" style="stroke:#000000"/> -<circle cx="517" cy="119" r="0.5" style="stroke:#000000"/> -<circle cx="504" cy="110" r="0.5" style="stroke:#000000"/> -<circle cx="483" cy="136" r="0.5" style="stroke:#000000"/> -<circle cx="477" cy="106" r="0.5" style="stroke:#000000"/> -<circle cx="489" cy="112" r="0.5" style="stroke:#000000"/> -<circle cx="498" cy="120" r="0.5" style="stroke:#000000"/> -<circle cx="507" cy="111" r="0.5" style="stroke:#000000"/> -<circle cx="494" cy="93" r="0.5" style="stroke:#000000"/> -<circle cx="481" cy="118" r="0.5" style="stroke:#000000"/> -<circle cx="510" cy="96" r="0.5" style="stroke:#000000"/> -<circle cx="492" cy="137" r="0.5" style="stroke:#000000"/> -<circle cx="498" cy="118" r="0.5" style="stroke:#000000"/> -<circle cx="500" cy="120" r="0.5" style="stroke:#000000"/> -<circle cx="511" cy="138" r="0.5" style="stroke:#000000"/> -<circle cx="500" cy="120" r="0.5" style="stroke:#000000"/> -<circle cx="484" cy="106" r="0.5" style="stroke:#000000"/> -<circle cx="485" cy="129" r="0.5" style="stroke:#000000"/> -<circle cx="479" cy="109" r="0.5" style="stroke:#000000"/> -<circle cx="497" cy="115" r="0.5" style="stroke:#000000"/> -<circle cx="526" cy="120" r="0.5" style="stroke:#000000"/> -<circle cx="495" cy="123" r="0.5" style="stroke:#000000"/> -<circle cx="482" cy="106" r="0.5" style="stroke:#000000"/> -<circle cx="498" cy="119" r="0.5" style="stroke:#000000"/> -<circle cx="502" cy="116" r="0.5" style="stroke:#000000"/> -<circle cx="474" cy="131" r="0.5" style="stroke:#000000"/> -<circle cx="526" cy="122" r="0.5" style="stroke:#000000"/> -<circle cx="498" cy="117" r="0.5" style="stroke:#000000"/> -<circle cx="484" cy="121" r="0.5" style="stroke:#000000"/> -<circle cx="486" cy="136" r="0.5" style="stroke:#000000"/> -<circle cx="498" cy="118" r="0.5" style="stroke:#000000"/> -<circle cx="498" cy="131" r="0.5" style="stroke:#000000"/> -<circle cx="489" cy="142" r="0.5" style="stroke:#000000"/> -<circle cx="509" cy="105" r="0.5" style="stroke:#000000"/> -<circle cx="475" cy="136" r="0.5" style="stroke:#000000"/> -<circle cx="498" cy="148" r="0.5" style="stroke:#000000"/> -<circle cx="528" cy="126" r="0.5" style="stroke:#000000"/> -<circle cx="488" cy="117" r="0.5" style="stroke:#000000"/> -<circle cx="490" cy="104" r="0.5" style="stroke:#000000"/> -<circle cx="523" cy="117" r="0.5" style="stroke:#000000"/> -<circle cx="488" cy="109" r="0.5" style="stroke:#000000"/> -<circle cx="517" cy="107" r="0.5" style="stroke:#000000"/> -<circle cx="275" cy="163" r="0.5" style="stroke:#000000"/> -<circle cx="345" cy="212" r="0.5" style="stroke:#000000"/> -<circle cx="256" cy="277" r="0.5" style="stroke:#000000"/> -<circle cx="235" cy="324" r="0.5" style="stroke:#000000"/> -<circle cx="286" cy="206" r="0.5" style="stroke:#000000"/> -<circle cx="312" cy="311" r="0.5" style="stroke:#000000"/> -<circle cx="375" cy="163" r="0.5" style="stroke:#000000"/> -<circle cx="363" cy="164" r="0.5" style="stroke:#000000"/> -<circle cx="254" cy="126" r="0.5" style="stroke:#000000"/> -<circle cx="343" cy="243" r="0.5" style="stroke:#000000"/> -<circle cx="372" cy="133" r="0.5" style="stroke:#000000"/> -<circle cx="301" cy="201" r="0.5" style="stroke:#000000"/> -<circle cx="319" cy="193" r="0.5" style="stroke:#000000"/> -<circle cx="319" cy="311" r="0.5" style="stroke:#000000"/> -<circle cx="238" cy="232" r="0.5" style="stroke:#000000"/> -<circle cx="376" cy="310" r="0.5" style="stroke:#000000"/> -<circle cx="305" cy="203" r="0.5" style="stroke:#000000"/> -<circle cx="299" cy="177" r="0.5" style="stroke:#000000"/> -<circle cx="300" cy="201" r="0.5" style="stroke:#000000"/> -<circle cx="256" cy="179" r="0.5" style="stroke:#000000"/> -<circle cx="182" cy="162" r="0.5" style="stroke:#000000"/> -<circle cx="229" cy="158" r="0.5" style="stroke:#000000"/> -<circle cx="328" cy="75" r="0.5" style="stroke:#000000"/> -<circle cx="180" cy="161" r="0.5" style="stroke:#000000"/> -<circle cx="225" cy="144" r="0.5" style="stroke:#000000"/> -<circle cx="369" cy="245" r="0.5" style="stroke:#000000"/> -<circle cx="406" cy="282" r="0.5" style="stroke:#000000"/> -<circle cx="320" cy="245" r="0.5" style="stroke:#000000"/> -<circle cx="369" cy="328" r="0.5" style="stroke:#000000"/> -<circle cx="318" cy="115" r="0.5" style="stroke:#000000"/> -<circle cx="253" cy="221" r="0.5" style="stroke:#000000"/> -<circle cx="369" cy="332" r="0.5" style="stroke:#000000"/> -<circle cx="303" cy="140" r="0.5" style="stroke:#000000"/> -<circle cx="231" cy="259" r="0.5" style="stroke:#000000"/> -<circle cx="342" cy="159" r="0.5" style="stroke:#000000"/> -<circle cx="348" cy="208" r="0.5" style="stroke:#000000"/> -<circle cx="273" cy="283" r="0.5" style="stroke:#000000"/> -<circle cx="342" cy="241" r="0.5" style="stroke:#000000"/> -<circle cx="284" cy="177" r="0.5" style="stroke:#000000"/> -<circle cx="283" cy="276" r="0.5" style="stroke:#000000"/> -<circle cx="284" cy="159" r="0.5" style="stroke:#000000"/> -<circle cx="348" cy="222" r="0.5" style="stroke:#000000"/> -<circle cx="269" cy="159" r="0.5" style="stroke:#000000"/> -<circle cx="388" cy="175" r="0.5" style="stroke:#000000"/> -<circle cx="245" cy="172" r="0.5" style="stroke:#000000"/> -<circle cx="200" cy="158" r="0.5" style="stroke:#000000"/> -<circle cx="351" cy="99" r="0.5" style="stroke:#000000"/> -<circle cx="300" cy="201" r="0.5" style="stroke:#000000"/> -<circle cx="379" cy="317" r="0.5" style="stroke:#000000"/> -<circle cx="301" cy="197" r="0.5" style="stroke:#000000"/> -<circle cx="277" cy="236" r="0.5" style="stroke:#000000"/> -<circle cx="275" cy="187" r="0.5" style="stroke:#000000"/> -<circle cx="324" cy="178" r="0.5" style="stroke:#000000"/> -<circle cx="292" cy="168" r="0.5" style="stroke:#000000"/> -<circle cx="312" cy="204" r="0.5" style="stroke:#000000"/> -<circle cx="345" cy="255" r="0.5" style="stroke:#000000"/> -<circle cx="262" cy="198" r="0.5" style="stroke:#000000"/> -<circle cx="403" cy="283" r="0.5" style="stroke:#000000"/> -<circle cx="223" cy="152" r="0.5" style="stroke:#000000"/> -<circle cx="207" cy="189" r="0.5" style="stroke:#000000"/> -<circle cx="305" cy="237" r="0.5" style="stroke:#000000"/> -<circle cx="303" cy="200" r="0.5" style="stroke:#000000"/> -<circle cx="150" cy="197" r="0.5" style="stroke:#000000"/> -<circle cx="286" cy="268" r="0.5" style="stroke:#000000"/> -<circle cx="254" cy="227" r="0.5" style="stroke:#000000"/> -<circle cx="254" cy="152" r="0.5" style="stroke:#000000"/> -<circle cx="387" cy="322" r="0.5" style="stroke:#000000"/> -<circle cx="250" cy="117" r="0.5" style="stroke:#000000"/> -<circle cx="341" cy="97" r="0.5" style="stroke:#000000"/> -<circle cx="327" cy="122" r="0.5" style="stroke:#000000"/> -<circle cx="412" cy="193" r="0.5" style="stroke:#000000"/> -<circle cx="329" cy="315" r="0.5" style="stroke:#000000"/> -<circle cx="372" cy="130" r="0.5" style="stroke:#000000"/> -<circle cx="328" cy="120" r="0.5" style="stroke:#000000"/> -<circle cx="279" cy="190" r="0.5" style="stroke:#000000"/> -<circle cx="248" cy="132" r="0.5" style="stroke:#000000"/> -<circle cx="213" cy="199" r="0.5" style="stroke:#000000"/> -<circle cx="291" cy="218" r="0.5" style="stroke:#000000"/> -<circle cx="297" cy="200" r="0.5" style="stroke:#000000"/> -<circle cx="264" cy="309" r="0.5" style="stroke:#000000"/> -<circle cx="257" cy="100" r="0.5" style="stroke:#000000"/> -<circle cx="308" cy="235" r="0.5" style="stroke:#000000"/> -<circle cx="296" cy="312" r="0.5" style="stroke:#000000"/> -<circle cx="305" cy="240" r="0.5" style="stroke:#000000"/> -<circle cx="264" cy="178" r="0.5" style="stroke:#000000"/> -<circle cx="383" cy="317" r="0.5" style="stroke:#000000"/> -<circle cx="319" cy="189" r="0.5" style="stroke:#000000"/> -<circle cx="247" cy="241" r="0.5" style="stroke:#000000"/> -<circle cx="306" cy="193" r="0.5" style="stroke:#000000"/> -<circle cx="302" cy="190" r="0.5" style="stroke:#000000"/> -<circle cx="292" cy="319" r="0.5" style="stroke:#000000"/> -<circle cx="298" cy="203" r="0.5" style="stroke:#000000"/> -<circle cx="280" cy="211" r="0.5" style="stroke:#000000"/> -<circle cx="296" cy="202" r="0.5" style="stroke:#000000"/> -<circle cx="243" cy="272" r="0.5" style="stroke:#000000"/> -<circle cx="392" cy="263" r="0.5" style="stroke:#000000"/> -<circle cx="331" cy="74" r="0.5" style="stroke:#000000"/> -<circle cx="292" cy="303" r="0.5" style="stroke:#000000"/> -<circle cx="310" cy="181" r="0.5" style="stroke:#000000"/> -<circle cx="302" cy="168" r="0.5" style="stroke:#000000"/> -<circle cx="287" cy="227" r="0.5" style="stroke:#000000"/> -<circle cx="288" cy="196" r="0.5" style="stroke:#000000"/> -<circle cx="326" cy="210" r="0.5" style="stroke:#000000"/> -<circle cx="244" cy="206" r="0.5" style="stroke:#000000"/> -<circle cx="325" cy="205" r="0.5" style="stroke:#000000"/> -<circle cx="287" cy="206" r="0.5" style="stroke:#000000"/> -<circle cx="194" cy="265" r="0.5" style="stroke:#000000"/> -<circle cx="397" cy="314" r="0.5" style="stroke:#000000"/> -<circle cx="307" cy="204" r="0.5" style="stroke:#000000"/> -<circle cx="286" cy="212" r="0.5" style="stroke:#000000"/> -<circle cx="436" cy="227" r="0.5" style="stroke:#000000"/> -<circle cx="373" cy="161" r="0.5" style="stroke:#000000"/> -<circle cx="298" cy="199" r="0.5" style="stroke:#000000"/> -<circle cx="244" cy="172" r="0.5" style="stroke:#000000"/> -<circle cx="360" cy="290" r="0.5" style="stroke:#000000"/> -<circle cx="299" cy="202" r="0.5" style="stroke:#000000"/> -<circle cx="300" cy="195" r="0.5" style="stroke:#000000"/> -<circle cx="201" cy="252" r="0.5" style="stroke:#000000"/> -<circle cx="323" cy="210" r="0.5" style="stroke:#000000"/> -<circle cx="350" cy="228" r="0.5" style="stroke:#000000"/> -<circle cx="341" cy="170" r="0.5" style="stroke:#000000"/> -<circle cx="349" cy="157" r="0.5" style="stroke:#000000"/> -<circle cx="340" cy="94" r="0.5" style="stroke:#000000"/> -<circle cx="202" cy="147" r="0.5" style="stroke:#000000"/> -<circle cx="254" cy="174" r="0.5" style="stroke:#000000"/> -<circle cx="309" cy="176" r="0.5" style="stroke:#000000"/> -<circle cx="260" cy="183" r="0.5" style="stroke:#000000"/> -<circle cx="391" cy="243" r="0.5" style="stroke:#000000"/> -<circle cx="326" cy="210" r="0.5" style="stroke:#000000"/> -<circle cx="210" cy="175" r="0.5" style="stroke:#000000"/> -<circle cx="300" cy="200" r="0.5" style="stroke:#000000"/> -<circle cx="364" cy="163" r="0.5" style="stroke:#000000"/> -<circle cx="271" cy="121" r="0.5" style="stroke:#000000"/> -<circle cx="294" cy="149" r="0.5" style="stroke:#000000"/> -<circle cx="278" cy="205" r="0.5" style="stroke:#000000"/> -<circle cx="245" cy="311" r="0.5" style="stroke:#000000"/> -<circle cx="363" cy="131" r="0.5" style="stroke:#000000"/> -<circle cx="262" cy="236" r="0.5" style="stroke:#000000"/> -<circle cx="369" cy="128" r="0.5" style="stroke:#000000"/> -<circle cx="317" cy="327" r="0.5" style="stroke:#000000"/> -<circle cx="283" cy="143" r="0.5" style="stroke:#000000"/> -<circle cx="239" cy="194" r="0.5" style="stroke:#000000"/> -<circle cx="333" cy="231" r="0.5" style="stroke:#000000"/> -<circle cx="340" cy="129" r="0.5" style="stroke:#000000"/> -<circle cx="271" cy="105" r="0.5" style="stroke:#000000"/> -<circle cx="302" cy="100" r="0.5" style="stroke:#000000"/> -<circle cx="303" cy="197" r="0.5" style="stroke:#000000"/> -<circle cx="395" cy="303" r="0.5" style="stroke:#000000"/> -<circle cx="210" cy="227" r="0.5" style="stroke:#000000"/> -<circle cx="317" cy="174" r="0.5" style="stroke:#000000"/> -<circle cx="441" cy="184" r="0.5" style="stroke:#000000"/> -<circle cx="447" cy="175" r="0.5" style="stroke:#000000"/> -<circle cx="294" cy="191" r="0.5" style="stroke:#000000"/> -<circle cx="281" cy="184" r="0.5" style="stroke:#000000"/> -<circle cx="212" cy="148" r="0.5" style="stroke:#000000"/> -<circle cx="315" cy="179" r="0.5" style="stroke:#000000"/> -<circle cx="318" cy="190" r="0.5" style="stroke:#000000"/> -<circle cx="232" cy="164" r="0.5" style="stroke:#000000"/> -<circle cx="425" cy="239" r="0.5" style="stroke:#000000"/> -<circle cx="387" cy="195" r="0.5" style="stroke:#000000"/> -<circle cx="322" cy="152" r="0.5" style="stroke:#000000"/> -<circle cx="213" cy="278" r="0.5" style="stroke:#000000"/> -<circle cx="187" cy="132" r="0.5" style="stroke:#000000"/> -<circle cx="245" cy="161" r="0.5" style="stroke:#000000"/> -<circle cx="292" cy="202" r="0.5" style="stroke:#000000"/> -<circle cx="336" cy="155" r="0.5" style="stroke:#000000"/> -<circle cx="272" cy="65" r="0.5" style="stroke:#000000"/> -<circle cx="204" cy="190" r="0.5" style="stroke:#000000"/> -<circle cx="351" cy="82" r="0.5" style="stroke:#000000"/> -<circle cx="259" cy="284" r="0.5" style="stroke:#000000"/> -<circle cx="288" cy="189" r="0.5" style="stroke:#000000"/> -<circle cx="300" cy="200" r="0.5" style="stroke:#000000"/> -<circle cx="353" cy="288" r="0.5" style="stroke:#000000"/> -<circle cx="301" cy="199" r="0.5" style="stroke:#000000"/> -<circle cx="218" cy="128" r="0.5" style="stroke:#000000"/> -<circle cx="226" cy="243" r="0.5" style="stroke:#000000"/> -<circle cx="195" cy="146" r="0.5" style="stroke:#000000"/> -<circle cx="284" cy="174" r="0.5" style="stroke:#000000"/> -<circle cx="428" cy="200" r="0.5" style="stroke:#000000"/> -<circle cx="274" cy="214" r="0.5" style="stroke:#000000"/> -<circle cx="211" cy="131" r="0.5" style="stroke:#000000"/> -<circle cx="291" cy="196" r="0.5" style="stroke:#000000"/> -<circle cx="310" cy="180" r="0.5" style="stroke:#000000"/> -<circle cx="172" cy="257" r="0.5" style="stroke:#000000"/> -<circle cx="431" cy="212" r="0.5" style="stroke:#000000"/> -<circle cx="290" cy="187" r="0.5" style="stroke:#000000"/> -<circle cx="219" cy="203" r="0.5" style="stroke:#000000"/> -<circle cx="230" cy="279" r="0.5" style="stroke:#000000"/> -<circle cx="291" cy="192" r="0.5" style="stroke:#000000"/> -<circle cx="291" cy="254" r="0.5" style="stroke:#000000"/> -<circle cx="245" cy="309" r="0.5" style="stroke:#000000"/> -<circle cx="345" cy="126" r="0.5" style="stroke:#000000"/> -<circle cx="175" cy="278" r="0.5" style="stroke:#000000"/> -<circle cx="289" cy="338" r="0.5" style="stroke:#000000"/> -<circle cx="442" cy="228" r="0.5" style="stroke:#000000"/> -<circle cx="242" cy="186" r="0.5" style="stroke:#000000"/> -<circle cx="249" cy="120" r="0.5" style="stroke:#000000"/> -<circle cx="415" cy="186" r="0.5" style="stroke:#000000"/> -<circle cx="242" cy="145" r="0.5" style="stroke:#000000"/> -<circle cx="384" cy="133" r="0.5" style="stroke:#000000"/> -<circle cx="20" cy="98" r="1" style="stroke:#ff0000"/> -<circle cx="50" cy="246" r="1" style="stroke:#ff0000"/> -<circle cx="83" cy="354" r="1" style="stroke:#ff0000"/> -<circle cx="164" cy="416" r="1" style="stroke:#ff0000"/> -<circle cx="236" cy="434" r="1" style="stroke:#ff0000"/> -<circle cx="343" cy="427" r="1" style="stroke:#ff0000"/> -<circle cx="366" cy="412" r="1" style="stroke:#ff0000"/> -<circle cx="379" cy="402" r="1" style="stroke:#ff0000"/> -<circle cx="519" cy="143" r="1" style="stroke:#ff0000"/> -<circle cx="528" cy="126" r="1" style="stroke:#ff0000"/> -<circle cx="529" cy="115" r="1" style="stroke:#ff0000"/> -<circle cx="510" cy="96" r="1" style="stroke:#ff0000"/> -<circle cx="506" cy="95" r="1" style="stroke:#ff0000"/> -<circle cx="117" cy="33" r="1" style="stroke:#ff0000"/> -<circle cx="85" cy="28" r="1" style="stroke:#ff0000"/> -<circle cx="40" cy="64" r="1" style="stroke:#ff0000"/> -</svg> diff --git a/testsuite/tests/dph/quickhull/dph-quickhull-copy-opt.stdout b/testsuite/tests/dph/quickhull/dph-quickhull-copy-opt.stdout deleted file mode 100644 index f6b2d92e9a..0000000000 --- a/testsuite/tests/dph/quickhull/dph-quickhull-copy-opt.stdout +++ /dev/null @@ -1,1019 +0,0 @@ -<svg width="100%" height="100%" version="1.1" xmlns="http://www.w3.org/2000/svg"> -<polygon points="20,98 50,246 83,354 164,416 236,434 343,427 366,412 379,402 519,143 528,126 529,115 510,96 506,95 117,33 85,28 40,64 " style="fill:#d0d0ff;stroke:#000000;stroke-width:1"/> -<circle cx="217" cy="201" r="0.5" style="stroke:#000000"/> -<circle cx="310" cy="266" r="0.5" style="stroke:#000000"/> -<circle cx="191" cy="353" r="0.5" style="stroke:#000000"/> -<circle cx="164" cy="416" r="0.5" style="stroke:#000000"/> -<circle cx="232" cy="257" r="0.5" style="stroke:#000000"/> -<circle cx="266" cy="398" r="0.5" style="stroke:#000000"/> -<circle cx="350" cy="201" r="0.5" style="stroke:#000000"/> -<circle cx="334" cy="202" r="0.5" style="stroke:#000000"/> -<circle cx="189" cy="151" r="0.5" style="stroke:#000000"/> -<circle cx="308" cy="307" r="0.5" style="stroke:#000000"/> -<circle cx="347" cy="160" r="0.5" style="stroke:#000000"/> -<circle cx="251" cy="251" r="0.5" style="stroke:#000000"/> -<circle cx="275" cy="241" r="0.5" style="stroke:#000000"/> -<circle cx="275" cy="398" r="0.5" style="stroke:#000000"/> -<circle cx="167" cy="292" r="0.5" style="stroke:#000000"/> -<circle cx="351" cy="397" r="0.5" style="stroke:#000000"/> -<circle cx="257" cy="254" r="0.5" style="stroke:#000000"/> -<circle cx="248" cy="220" r="0.5" style="stroke:#000000"/> -<circle cx="250" cy="252" r="0.5" style="stroke:#000000"/> -<circle cx="191" cy="222" r="0.5" style="stroke:#000000"/> -<circle cx="93" cy="200" r="0.5" style="stroke:#000000"/> -<circle cx="155" cy="195" r="0.5" style="stroke:#000000"/> -<circle cx="287" cy="84" r="0.5" style="stroke:#000000"/> -<circle cx="90" cy="198" r="0.5" style="stroke:#000000"/> -<circle cx="149" cy="175" r="0.5" style="stroke:#000000"/> -<circle cx="342" cy="311" r="0.5" style="stroke:#000000"/> -<circle cx="391" cy="360" r="0.5" style="stroke:#000000"/> -<circle cx="277" cy="310" r="0.5" style="stroke:#000000"/> -<circle cx="341" cy="421" r="0.5" style="stroke:#000000"/> -<circle cx="274" cy="136" r="0.5" style="stroke:#000000"/> -<circle cx="187" cy="278" r="0.5" style="stroke:#000000"/> -<circle cx="343" cy="427" r="0.5" style="stroke:#000000"/> -<circle cx="255" cy="170" r="0.5" style="stroke:#000000"/> -<circle cx="158" cy="329" r="0.5" style="stroke:#000000"/> -<circle cx="306" cy="196" r="0.5" style="stroke:#000000"/> -<circle cx="315" cy="261" r="0.5" style="stroke:#000000"/> -<circle cx="214" cy="361" r="0.5" style="stroke:#000000"/> -<circle cx="306" cy="304" r="0.5" style="stroke:#000000"/> -<circle cx="229" cy="219" r="0.5" style="stroke:#000000"/> -<circle cx="227" cy="351" r="0.5" style="stroke:#000000"/> -<circle cx="228" cy="196" r="0.5" style="stroke:#000000"/> -<circle cx="314" cy="280" r="0.5" style="stroke:#000000"/> -<circle cx="209" cy="195" r="0.5" style="stroke:#000000"/> -<circle cx="367" cy="217" r="0.5" style="stroke:#000000"/> -<circle cx="176" cy="212" r="0.5" style="stroke:#000000"/> -<circle cx="117" cy="194" r="0.5" style="stroke:#000000"/> -<circle cx="318" cy="116" r="0.5" style="stroke:#000000"/> -<circle cx="250" cy="251" r="0.5" style="stroke:#000000"/> -<circle cx="355" cy="406" r="0.5" style="stroke:#000000"/> -<circle cx="252" cy="246" r="0.5" style="stroke:#000000"/> -<circle cx="219" cy="299" r="0.5" style="stroke:#000000"/> -<circle cx="217" cy="232" r="0.5" style="stroke:#000000"/> -<circle cx="283" cy="220" r="0.5" style="stroke:#000000"/> -<circle cx="239" cy="207" r="0.5" style="stroke:#000000"/> -<circle cx="266" cy="255" r="0.5" style="stroke:#000000"/> -<circle cx="310" cy="324" r="0.5" style="stroke:#000000"/> -<circle cx="200" cy="248" r="0.5" style="stroke:#000000"/> -<circle cx="387" cy="360" r="0.5" style="stroke:#000000"/> -<circle cx="147" cy="186" r="0.5" style="stroke:#000000"/> -<circle cx="126" cy="236" r="0.5" style="stroke:#000000"/> -<circle cx="257" cy="300" r="0.5" style="stroke:#000000"/> -<circle cx="255" cy="250" r="0.5" style="stroke:#000000"/> -<circle cx="50" cy="246" r="0.5" style="stroke:#000000"/> -<circle cx="231" cy="340" r="0.5" style="stroke:#000000"/> -<circle cx="189" cy="287" r="0.5" style="stroke:#000000"/> -<circle cx="188" cy="186" r="0.5" style="stroke:#000000"/> -<circle cx="366" cy="412" r="0.5" style="stroke:#000000"/> -<circle cx="183" cy="139" r="0.5" style="stroke:#000000"/> -<circle cx="305" cy="113" r="0.5" style="stroke:#000000"/> -<circle cx="286" cy="146" r="0.5" style="stroke:#000000"/> -<circle cx="399" cy="241" r="0.5" style="stroke:#000000"/> -<circle cx="289" cy="404" r="0.5" style="stroke:#000000"/> -<circle cx="346" cy="157" r="0.5" style="stroke:#000000"/> -<circle cx="287" cy="143" r="0.5" style="stroke:#000000"/> -<circle cx="223" cy="236" r="0.5" style="stroke:#000000"/> -<circle cx="181" cy="159" r="0.5" style="stroke:#000000"/> -<circle cx="134" cy="249" r="0.5" style="stroke:#000000"/> -<circle cx="238" cy="274" r="0.5" style="stroke:#000000"/> -<circle cx="246" cy="250" r="0.5" style="stroke:#000000"/> -<circle cx="201" cy="395" r="0.5" style="stroke:#000000"/> -<circle cx="192" cy="116" r="0.5" style="stroke:#000000"/> -<circle cx="260" cy="296" r="0.5" style="stroke:#000000"/> -<circle cx="244" cy="399" r="0.5" style="stroke:#000000"/> -<circle cx="256" cy="303" r="0.5" style="stroke:#000000"/> -<circle cx="202" cy="221" r="0.5" style="stroke:#000000"/> -<circle cx="361" cy="406" r="0.5" style="stroke:#000000"/> -<circle cx="275" cy="235" r="0.5" style="stroke:#000000"/> -<circle cx="180" cy="305" r="0.5" style="stroke:#000000"/> -<circle cx="258" cy="241" r="0.5" style="stroke:#000000"/> -<circle cx="253" cy="237" r="0.5" style="stroke:#000000"/> -<circle cx="239" cy="408" r="0.5" style="stroke:#000000"/> -<circle cx="247" cy="254" r="0.5" style="stroke:#000000"/> -<circle cx="223" cy="265" r="0.5" style="stroke:#000000"/> -<circle cx="244" cy="253" r="0.5" style="stroke:#000000"/> -<circle cx="174" cy="346" r="0.5" style="stroke:#000000"/> -<circle cx="373" cy="334" r="0.5" style="stroke:#000000"/> -<circle cx="292" cy="82" r="0.5" style="stroke:#000000"/> -<circle cx="240" cy="388" r="0.5" style="stroke:#000000"/> -<circle cx="263" cy="225" r="0.5" style="stroke:#000000"/> -<circle cx="252" cy="207" r="0.5" style="stroke:#000000"/> -<circle cx="233" cy="287" r="0.5" style="stroke:#000000"/> -<circle cx="234" cy="245" r="0.5" style="stroke:#000000"/> -<circle cx="285" cy="264" r="0.5" style="stroke:#000000"/> -<circle cx="176" cy="259" r="0.5" style="stroke:#000000"/> -<circle cx="284" cy="256" r="0.5" style="stroke:#000000"/> -<circle cx="233" cy="258" r="0.5" style="stroke:#000000"/> -<circle cx="108" cy="336" r="0.5" style="stroke:#000000"/> -<circle cx="379" cy="402" r="0.5" style="stroke:#000000"/> -<circle cx="260" cy="256" r="0.5" style="stroke:#000000"/> -<circle cx="232" cy="265" r="0.5" style="stroke:#000000"/> -<circle cx="432" cy="286" r="0.5" style="stroke:#000000"/> -<circle cx="347" cy="197" r="0.5" style="stroke:#000000"/> -<circle cx="248" cy="249" r="0.5" style="stroke:#000000"/> -<circle cx="176" cy="213" r="0.5" style="stroke:#000000"/> -<circle cx="330" cy="370" r="0.5" style="stroke:#000000"/> -<circle cx="249" cy="253" r="0.5" style="stroke:#000000"/> -<circle cx="249" cy="243" r="0.5" style="stroke:#000000"/> -<circle cx="119" cy="320" r="0.5" style="stroke:#000000"/> -<circle cx="280" cy="263" r="0.5" style="stroke:#000000"/> -<circle cx="317" cy="287" r="0.5" style="stroke:#000000"/> -<circle cx="304" cy="209" r="0.5" style="stroke:#000000"/> -<circle cx="315" cy="193" r="0.5" style="stroke:#000000"/> -<circle cx="304" cy="109" r="0.5" style="stroke:#000000"/> -<circle cx="119" cy="179" r="0.5" style="stroke:#000000"/> -<circle cx="188" cy="215" r="0.5" style="stroke:#000000"/> -<circle cx="263" cy="218" r="0.5" style="stroke:#000000"/> -<circle cx="196" cy="228" r="0.5" style="stroke:#000000"/> -<circle cx="371" cy="307" r="0.5" style="stroke:#000000"/> -<circle cx="285" cy="263" r="0.5" style="stroke:#000000"/> -<circle cx="130" cy="217" r="0.5" style="stroke:#000000"/> -<circle cx="250" cy="250" r="0.5" style="stroke:#000000"/> -<circle cx="335" cy="201" r="0.5" style="stroke:#000000"/> -<circle cx="211" cy="145" r="0.5" style="stroke:#000000"/> -<circle cx="242" cy="182" r="0.5" style="stroke:#000000"/> -<circle cx="221" cy="256" r="0.5" style="stroke:#000000"/> -<circle cx="177" cy="398" r="0.5" style="stroke:#000000"/> -<circle cx="333" cy="158" r="0.5" style="stroke:#000000"/> -<circle cx="199" cy="297" r="0.5" style="stroke:#000000"/> -<circle cx="342" cy="153" r="0.5" style="stroke:#000000"/> -<circle cx="273" cy="419" r="0.5" style="stroke:#000000"/> -<circle cx="227" cy="173" r="0.5" style="stroke:#000000"/> -<circle cx="169" cy="242" r="0.5" style="stroke:#000000"/> -<circle cx="294" cy="292" r="0.5" style="stroke:#000000"/> -<circle cx="303" cy="155" r="0.5" style="stroke:#000000"/> -<circle cx="211" cy="124" r="0.5" style="stroke:#000000"/> -<circle cx="253" cy="116" r="0.5" style="stroke:#000000"/> -<circle cx="254" cy="246" r="0.5" style="stroke:#000000"/> -<circle cx="377" cy="388" r="0.5" style="stroke:#000000"/> -<circle cx="130" cy="285" r="0.5" style="stroke:#000000"/> -<circle cx="273" cy="215" r="0.5" style="stroke:#000000"/> -<circle cx="438" cy="229" r="0.5" style="stroke:#000000"/> -<circle cx="446" cy="216" r="0.5" style="stroke:#000000"/> -<circle cx="242" cy="238" r="0.5" style="stroke:#000000"/> -<circle cx="224" cy="229" r="0.5" style="stroke:#000000"/> -<circle cx="133" cy="181" r="0.5" style="stroke:#000000"/> -<circle cx="270" cy="222" r="0.5" style="stroke:#000000"/> -<circle cx="275" cy="237" r="0.5" style="stroke:#000000"/> -<circle cx="160" cy="202" r="0.5" style="stroke:#000000"/> -<circle cx="416" cy="302" r="0.5" style="stroke:#000000"/> -<circle cx="366" cy="244" r="0.5" style="stroke:#000000"/> -<circle cx="279" cy="186" r="0.5" style="stroke:#000000"/> -<circle cx="134" cy="353" r="0.5" style="stroke:#000000"/> -<circle cx="99" cy="159" r="0.5" style="stroke:#000000"/> -<circle cx="177" cy="198" r="0.5" style="stroke:#000000"/> -<circle cx="239" cy="253" r="0.5" style="stroke:#000000"/> -<circle cx="298" cy="190" r="0.5" style="stroke:#000000"/> -<circle cx="213" cy="70" r="0.5" style="stroke:#000000"/> -<circle cx="122" cy="236" r="0.5" style="stroke:#000000"/> -<circle cx="318" cy="92" r="0.5" style="stroke:#000000"/> -<circle cx="196" cy="362" r="0.5" style="stroke:#000000"/> -<circle cx="234" cy="235" r="0.5" style="stroke:#000000"/> -<circle cx="250" cy="250" r="0.5" style="stroke:#000000"/> -<circle cx="321" cy="367" r="0.5" style="stroke:#000000"/> -<circle cx="251" cy="249" r="0.5" style="stroke:#000000"/> -<circle cx="141" cy="154" r="0.5" style="stroke:#000000"/> -<circle cx="152" cy="308" r="0.5" style="stroke:#000000"/> -<circle cx="110" cy="178" r="0.5" style="stroke:#000000"/> -<circle cx="229" cy="216" r="0.5" style="stroke:#000000"/> -<circle cx="421" cy="250" r="0.5" style="stroke:#000000"/> -<circle cx="215" cy="269" r="0.5" style="stroke:#000000"/> -<circle cx="131" cy="157" r="0.5" style="stroke:#000000"/> -<circle cx="238" cy="245" r="0.5" style="stroke:#000000"/> -<circle cx="264" cy="224" r="0.5" style="stroke:#000000"/> -<circle cx="79" cy="327" r="0.5" style="stroke:#000000"/> -<circle cx="424" cy="266" r="0.5" style="stroke:#000000"/> -<circle cx="237" cy="232" r="0.5" style="stroke:#000000"/> -<circle cx="142" cy="253" r="0.5" style="stroke:#000000"/> -<circle cx="156" cy="355" r="0.5" style="stroke:#000000"/> -<circle cx="239" cy="239" r="0.5" style="stroke:#000000"/> -<circle cx="238" cy="322" r="0.5" style="stroke:#000000"/> -<circle cx="177" cy="396" r="0.5" style="stroke:#000000"/> -<circle cx="310" cy="152" r="0.5" style="stroke:#000000"/> -<circle cx="83" cy="354" r="0.5" style="stroke:#000000"/> -<circle cx="236" cy="434" r="0.5" style="stroke:#000000"/> -<circle cx="439" cy="287" r="0.5" style="stroke:#000000"/> -<circle cx="173" cy="232" r="0.5" style="stroke:#000000"/> -<circle cx="181" cy="143" r="0.5" style="stroke:#000000"/> -<circle cx="404" cy="232" r="0.5" style="stroke:#000000"/> -<circle cx="173" cy="177" r="0.5" style="stroke:#000000"/> -<circle cx="362" cy="161" r="0.5" style="stroke:#000000"/> -<circle cx="87" cy="81" r="0.5" style="stroke:#000000"/> -<circle cx="124" cy="106" r="0.5" style="stroke:#000000"/> -<circle cx="76" cy="141" r="0.5" style="stroke:#000000"/> -<circle cx="65" cy="166" r="0.5" style="stroke:#000000"/> -<circle cx="93" cy="103" r="0.5" style="stroke:#000000"/> -<circle cx="107" cy="159" r="0.5" style="stroke:#000000"/> -<circle cx="140" cy="80" r="0.5" style="stroke:#000000"/> -<circle cx="134" cy="81" r="0.5" style="stroke:#000000"/> -<circle cx="76" cy="60" r="0.5" style="stroke:#000000"/> -<circle cx="123" cy="123" r="0.5" style="stroke:#000000"/> -<circle cx="139" cy="64" r="0.5" style="stroke:#000000"/> -<circle cx="100" cy="100" r="0.5" style="stroke:#000000"/> -<circle cx="110" cy="96" r="0.5" style="stroke:#000000"/> -<circle cx="110" cy="159" r="0.5" style="stroke:#000000"/> -<circle cx="67" cy="117" r="0.5" style="stroke:#000000"/> -<circle cx="140" cy="159" r="0.5" style="stroke:#000000"/> -<circle cx="103" cy="101" r="0.5" style="stroke:#000000"/> -<circle cx="99" cy="88" r="0.5" style="stroke:#000000"/> -<circle cx="100" cy="101" r="0.5" style="stroke:#000000"/> -<circle cx="76" cy="89" r="0.5" style="stroke:#000000"/> -<circle cx="37" cy="80" r="0.5" style="stroke:#000000"/> -<circle cx="62" cy="78" r="0.5" style="stroke:#000000"/> -<circle cx="115" cy="34" r="0.5" style="stroke:#000000"/> -<circle cx="36" cy="79" r="0.5" style="stroke:#000000"/> -<circle cx="60" cy="70" r="0.5" style="stroke:#000000"/> -<circle cx="137" cy="124" r="0.5" style="stroke:#000000"/> -<circle cx="156" cy="144" r="0.5" style="stroke:#000000"/> -<circle cx="111" cy="124" r="0.5" style="stroke:#000000"/> -<circle cx="137" cy="168" r="0.5" style="stroke:#000000"/> -<circle cx="110" cy="55" r="0.5" style="stroke:#000000"/> -<circle cx="75" cy="111" r="0.5" style="stroke:#000000"/> -<circle cx="137" cy="171" r="0.5" style="stroke:#000000"/> -<circle cx="102" cy="68" r="0.5" style="stroke:#000000"/> -<circle cx="63" cy="131" r="0.5" style="stroke:#000000"/> -<circle cx="122" cy="78" r="0.5" style="stroke:#000000"/> -<circle cx="126" cy="104" r="0.5" style="stroke:#000000"/> -<circle cx="86" cy="144" r="0.5" style="stroke:#000000"/> -<circle cx="123" cy="122" r="0.5" style="stroke:#000000"/> -<circle cx="92" cy="88" r="0.5" style="stroke:#000000"/> -<circle cx="91" cy="140" r="0.5" style="stroke:#000000"/> -<circle cx="91" cy="78" r="0.5" style="stroke:#000000"/> -<circle cx="126" cy="112" r="0.5" style="stroke:#000000"/> -<circle cx="84" cy="78" r="0.5" style="stroke:#000000"/> -<circle cx="147" cy="87" r="0.5" style="stroke:#000000"/> -<circle cx="70" cy="85" r="0.5" style="stroke:#000000"/> -<circle cx="47" cy="77" r="0.5" style="stroke:#000000"/> -<circle cx="127" cy="46" r="0.5" style="stroke:#000000"/> -<circle cx="100" cy="100" r="0.5" style="stroke:#000000"/> -<circle cx="142" cy="163" r="0.5" style="stroke:#000000"/> -<circle cx="101" cy="99" r="0.5" style="stroke:#000000"/> -<circle cx="88" cy="119" r="0.5" style="stroke:#000000"/> -<circle cx="87" cy="93" r="0.5" style="stroke:#000000"/> -<circle cx="113" cy="88" r="0.5" style="stroke:#000000"/> -<circle cx="96" cy="83" r="0.5" style="stroke:#000000"/> -<circle cx="106" cy="102" r="0.5" style="stroke:#000000"/> -<circle cx="124" cy="130" r="0.5" style="stroke:#000000"/> -<circle cx="80" cy="99" r="0.5" style="stroke:#000000"/> -<circle cx="155" cy="144" r="0.5" style="stroke:#000000"/> -<circle cx="59" cy="74" r="0.5" style="stroke:#000000"/> -<circle cx="50" cy="94" r="0.5" style="stroke:#000000"/> -<circle cx="103" cy="120" r="0.5" style="stroke:#000000"/> -<circle cx="102" cy="100" r="0.5" style="stroke:#000000"/> -<circle cx="20" cy="98" r="0.5" style="stroke:#000000"/> -<circle cx="92" cy="136" r="0.5" style="stroke:#000000"/> -<circle cx="75" cy="115" r="0.5" style="stroke:#000000"/> -<circle cx="75" cy="74" r="0.5" style="stroke:#000000"/> -<circle cx="146" cy="165" r="0.5" style="stroke:#000000"/> -<circle cx="73" cy="56" r="0.5" style="stroke:#000000"/> -<circle cx="122" cy="45" r="0.5" style="stroke:#000000"/> -<circle cx="115" cy="59" r="0.5" style="stroke:#000000"/> -<circle cx="160" cy="97" r="0.5" style="stroke:#000000"/> -<circle cx="116" cy="161" r="0.5" style="stroke:#000000"/> -<circle cx="139" cy="63" r="0.5" style="stroke:#000000"/> -<circle cx="115" cy="57" r="0.5" style="stroke:#000000"/> -<circle cx="89" cy="94" r="0.5" style="stroke:#000000"/> -<circle cx="72" cy="64" r="0.5" style="stroke:#000000"/> -<circle cx="53" cy="99" r="0.5" style="stroke:#000000"/> -<circle cx="95" cy="110" r="0.5" style="stroke:#000000"/> -<circle cx="99" cy="100" r="0.5" style="stroke:#000000"/> -<circle cx="81" cy="158" r="0.5" style="stroke:#000000"/> -<circle cx="77" cy="46" r="0.5" style="stroke:#000000"/> -<circle cx="104" cy="118" r="0.5" style="stroke:#000000"/> -<circle cx="98" cy="160" r="0.5" style="stroke:#000000"/> -<circle cx="102" cy="121" r="0.5" style="stroke:#000000"/> -<circle cx="81" cy="88" r="0.5" style="stroke:#000000"/> -<circle cx="145" cy="163" r="0.5" style="stroke:#000000"/> -<circle cx="110" cy="94" r="0.5" style="stroke:#000000"/> -<circle cx="72" cy="122" r="0.5" style="stroke:#000000"/> -<circle cx="103" cy="96" r="0.5" style="stroke:#000000"/> -<circle cx="101" cy="95" r="0.5" style="stroke:#000000"/> -<circle cx="95" cy="163" r="0.5" style="stroke:#000000"/> -<circle cx="99" cy="101" r="0.5" style="stroke:#000000"/> -<circle cx="89" cy="106" r="0.5" style="stroke:#000000"/> -<circle cx="98" cy="101" r="0.5" style="stroke:#000000"/> -<circle cx="70" cy="138" r="0.5" style="stroke:#000000"/> -<circle cx="149" cy="134" r="0.5" style="stroke:#000000"/> -<circle cx="117" cy="33" r="0.5" style="stroke:#000000"/> -<circle cx="96" cy="155" r="0.5" style="stroke:#000000"/> -<circle cx="105" cy="90" r="0.5" style="stroke:#000000"/> -<circle cx="101" cy="83" r="0.5" style="stroke:#000000"/> -<circle cx="93" cy="115" r="0.5" style="stroke:#000000"/> -<circle cx="94" cy="98" r="0.5" style="stroke:#000000"/> -<circle cx="114" cy="105" r="0.5" style="stroke:#000000"/> -<circle cx="70" cy="103" r="0.5" style="stroke:#000000"/> -<circle cx="114" cy="103" r="0.5" style="stroke:#000000"/> -<circle cx="93" cy="103" r="0.5" style="stroke:#000000"/> -<circle cx="43" cy="135" r="0.5" style="stroke:#000000"/> -<circle cx="152" cy="161" r="0.5" style="stroke:#000000"/> -<circle cx="104" cy="102" r="0.5" style="stroke:#000000"/> -<circle cx="93" cy="106" r="0.5" style="stroke:#000000"/> -<circle cx="173" cy="115" r="0.5" style="stroke:#000000"/> -<circle cx="139" cy="79" r="0.5" style="stroke:#000000"/> -<circle cx="99" cy="99" r="0.5" style="stroke:#000000"/> -<circle cx="70" cy="85" r="0.5" style="stroke:#000000"/> -<circle cx="132" cy="148" r="0.5" style="stroke:#000000"/> -<circle cx="99" cy="101" r="0.5" style="stroke:#000000"/> -<circle cx="100" cy="97" r="0.5" style="stroke:#000000"/> -<circle cx="47" cy="128" r="0.5" style="stroke:#000000"/> -<circle cx="112" cy="105" r="0.5" style="stroke:#000000"/> -<circle cx="127" cy="115" r="0.5" style="stroke:#000000"/> -<circle cx="122" cy="84" r="0.5" style="stroke:#000000"/> -<circle cx="126" cy="77" r="0.5" style="stroke:#000000"/> -<circle cx="121" cy="44" r="0.5" style="stroke:#000000"/> -<circle cx="48" cy="72" r="0.5" style="stroke:#000000"/> -<circle cx="75" cy="86" r="0.5" style="stroke:#000000"/> -<circle cx="105" cy="87" r="0.5" style="stroke:#000000"/> -<circle cx="79" cy="91" r="0.5" style="stroke:#000000"/> -<circle cx="148" cy="123" r="0.5" style="stroke:#000000"/> -<circle cx="114" cy="105" r="0.5" style="stroke:#000000"/> -<circle cx="52" cy="87" r="0.5" style="stroke:#000000"/> -<circle cx="100" cy="100" r="0.5" style="stroke:#000000"/> -<circle cx="134" cy="80" r="0.5" style="stroke:#000000"/> -<circle cx="84" cy="58" r="0.5" style="stroke:#000000"/> -<circle cx="97" cy="73" r="0.5" style="stroke:#000000"/> -<circle cx="88" cy="102" r="0.5" style="stroke:#000000"/> -<circle cx="71" cy="159" r="0.5" style="stroke:#000000"/> -<circle cx="133" cy="63" r="0.5" style="stroke:#000000"/> -<circle cx="80" cy="119" r="0.5" style="stroke:#000000"/> -<circle cx="137" cy="61" r="0.5" style="stroke:#000000"/> -<circle cx="109" cy="168" r="0.5" style="stroke:#000000"/> -<circle cx="91" cy="69" r="0.5" style="stroke:#000000"/> -<circle cx="68" cy="97" r="0.5" style="stroke:#000000"/> -<circle cx="117" cy="117" r="0.5" style="stroke:#000000"/> -<circle cx="121" cy="62" r="0.5" style="stroke:#000000"/> -<circle cx="84" cy="50" r="0.5" style="stroke:#000000"/> -<circle cx="101" cy="46" r="0.5" style="stroke:#000000"/> -<circle cx="102" cy="98" r="0.5" style="stroke:#000000"/> -<circle cx="151" cy="155" r="0.5" style="stroke:#000000"/> -<circle cx="52" cy="114" r="0.5" style="stroke:#000000"/> -<circle cx="109" cy="86" r="0.5" style="stroke:#000000"/> -<circle cx="175" cy="91" r="0.5" style="stroke:#000000"/> -<circle cx="178" cy="87" r="0.5" style="stroke:#000000"/> -<circle cx="97" cy="95" r="0.5" style="stroke:#000000"/> -<circle cx="90" cy="92" r="0.5" style="stroke:#000000"/> -<circle cx="53" cy="72" r="0.5" style="stroke:#000000"/> -<circle cx="108" cy="89" r="0.5" style="stroke:#000000"/> -<circle cx="110" cy="95" r="0.5" style="stroke:#000000"/> -<circle cx="64" cy="81" r="0.5" style="stroke:#000000"/> -<circle cx="166" cy="121" r="0.5" style="stroke:#000000"/> -<circle cx="146" cy="97" r="0.5" style="stroke:#000000"/> -<circle cx="112" cy="74" r="0.5" style="stroke:#000000"/> -<circle cx="54" cy="141" r="0.5" style="stroke:#000000"/> -<circle cx="40" cy="64" r="0.5" style="stroke:#000000"/> -<circle cx="71" cy="79" r="0.5" style="stroke:#000000"/> -<circle cx="96" cy="101" r="0.5" style="stroke:#000000"/> -<circle cx="119" cy="76" r="0.5" style="stroke:#000000"/> -<circle cx="85" cy="28" r="0.5" style="stroke:#000000"/> -<circle cx="49" cy="94" r="0.5" style="stroke:#000000"/> -<circle cx="127" cy="37" r="0.5" style="stroke:#000000"/> -<circle cx="78" cy="145" r="0.5" style="stroke:#000000"/> -<circle cx="94" cy="94" r="0.5" style="stroke:#000000"/> -<circle cx="100" cy="100" r="0.5" style="stroke:#000000"/> -<circle cx="128" cy="147" r="0.5" style="stroke:#000000"/> -<circle cx="101" cy="100" r="0.5" style="stroke:#000000"/> -<circle cx="56" cy="62" r="0.5" style="stroke:#000000"/> -<circle cx="61" cy="123" r="0.5" style="stroke:#000000"/> -<circle cx="44" cy="71" r="0.5" style="stroke:#000000"/> -<circle cx="92" cy="86" r="0.5" style="stroke:#000000"/> -<circle cx="169" cy="100" r="0.5" style="stroke:#000000"/> -<circle cx="86" cy="107" r="0.5" style="stroke:#000000"/> -<circle cx="52" cy="63" r="0.5" style="stroke:#000000"/> -<circle cx="95" cy="98" r="0.5" style="stroke:#000000"/> -<circle cx="106" cy="89" r="0.5" style="stroke:#000000"/> -<circle cx="32" cy="131" r="0.5" style="stroke:#000000"/> -<circle cx="170" cy="106" r="0.5" style="stroke:#000000"/> -<circle cx="95" cy="93" r="0.5" style="stroke:#000000"/> -<circle cx="57" cy="101" r="0.5" style="stroke:#000000"/> -<circle cx="62" cy="142" r="0.5" style="stroke:#000000"/> -<circle cx="95" cy="95" r="0.5" style="stroke:#000000"/> -<circle cx="95" cy="129" r="0.5" style="stroke:#000000"/> -<circle cx="71" cy="158" r="0.5" style="stroke:#000000"/> -<circle cx="124" cy="61" r="0.5" style="stroke:#000000"/> -<circle cx="33" cy="142" r="0.5" style="stroke:#000000"/> -<circle cx="94" cy="174" r="0.5" style="stroke:#000000"/> -<circle cx="176" cy="115" r="0.5" style="stroke:#000000"/> -<circle cx="69" cy="93" r="0.5" style="stroke:#000000"/> -<circle cx="73" cy="57" r="0.5" style="stroke:#000000"/> -<circle cx="162" cy="93" r="0.5" style="stroke:#000000"/> -<circle cx="69" cy="71" r="0.5" style="stroke:#000000"/> -<circle cx="145" cy="64" r="0.5" style="stroke:#000000"/> -<circle cx="145" cy="293" r="0.5" style="stroke:#000000"/> -<circle cx="159" cy="302" r="0.5" style="stroke:#000000"/> -<circle cx="141" cy="315" r="0.5" style="stroke:#000000"/> -<circle cx="137" cy="325" r="0.5" style="stroke:#000000"/> -<circle cx="147" cy="301" r="0.5" style="stroke:#000000"/> -<circle cx="152" cy="322" r="0.5" style="stroke:#000000"/> -<circle cx="165" cy="293" r="0.5" style="stroke:#000000"/> -<circle cx="163" cy="293" r="0.5" style="stroke:#000000"/> -<circle cx="141" cy="285" r="0.5" style="stroke:#000000"/> -<circle cx="159" cy="309" r="0.5" style="stroke:#000000"/> -<circle cx="164" cy="287" r="0.5" style="stroke:#000000"/> -<circle cx="150" cy="300" r="0.5" style="stroke:#000000"/> -<circle cx="154" cy="299" r="0.5" style="stroke:#000000"/> -<circle cx="154" cy="322" r="0.5" style="stroke:#000000"/> -<circle cx="138" cy="306" r="0.5" style="stroke:#000000"/> -<circle cx="165" cy="322" r="0.5" style="stroke:#000000"/> -<circle cx="151" cy="301" r="0.5" style="stroke:#000000"/> -<circle cx="150" cy="295" r="0.5" style="stroke:#000000"/> -<circle cx="150" cy="300" r="0.5" style="stroke:#000000"/> -<circle cx="141" cy="296" r="0.5" style="stroke:#000000"/> -<circle cx="126" cy="292" r="0.5" style="stroke:#000000"/> -<circle cx="136" cy="292" r="0.5" style="stroke:#000000"/> -<circle cx="156" cy="275" r="0.5" style="stroke:#000000"/> -<circle cx="126" cy="292" r="0.5" style="stroke:#000000"/> -<circle cx="135" cy="289" r="0.5" style="stroke:#000000"/> -<circle cx="164" cy="309" r="0.5" style="stroke:#000000"/> -<circle cx="171" cy="316" r="0.5" style="stroke:#000000"/> -<circle cx="154" cy="309" r="0.5" style="stroke:#000000"/> -<circle cx="164" cy="326" r="0.5" style="stroke:#000000"/> -<circle cx="154" cy="283" r="0.5" style="stroke:#000000"/> -<circle cx="141" cy="304" r="0.5" style="stroke:#000000"/> -<circle cx="164" cy="326" r="0.5" style="stroke:#000000"/> -<circle cx="151" cy="288" r="0.5" style="stroke:#000000"/> -<circle cx="136" cy="312" r="0.5" style="stroke:#000000"/> -<circle cx="158" cy="292" r="0.5" style="stroke:#000000"/> -<circle cx="160" cy="302" r="0.5" style="stroke:#000000"/> -<circle cx="145" cy="317" r="0.5" style="stroke:#000000"/> -<circle cx="158" cy="308" r="0.5" style="stroke:#000000"/> -<circle cx="147" cy="295" r="0.5" style="stroke:#000000"/> -<circle cx="147" cy="315" r="0.5" style="stroke:#000000"/> -<circle cx="147" cy="292" r="0.5" style="stroke:#000000"/> -<circle cx="160" cy="304" r="0.5" style="stroke:#000000"/> -<circle cx="144" cy="292" r="0.5" style="stroke:#000000"/> -<circle cx="168" cy="295" r="0.5" style="stroke:#000000"/> -<circle cx="139" cy="294" r="0.5" style="stroke:#000000"/> -<circle cx="130" cy="292" r="0.5" style="stroke:#000000"/> -<circle cx="160" cy="280" r="0.5" style="stroke:#000000"/> -<circle cx="150" cy="300" r="0.5" style="stroke:#000000"/> -<circle cx="166" cy="323" r="0.5" style="stroke:#000000"/> -<circle cx="150" cy="299" r="0.5" style="stroke:#000000"/> -<circle cx="145" cy="307" r="0.5" style="stroke:#000000"/> -<circle cx="145" cy="297" r="0.5" style="stroke:#000000"/> -<circle cx="155" cy="296" r="0.5" style="stroke:#000000"/> -<circle cx="148" cy="294" r="0.5" style="stroke:#000000"/> -<circle cx="152" cy="301" r="0.5" style="stroke:#000000"/> -<circle cx="159" cy="311" r="0.5" style="stroke:#000000"/> -<circle cx="142" cy="300" r="0.5" style="stroke:#000000"/> -<circle cx="171" cy="317" r="0.5" style="stroke:#000000"/> -<circle cx="135" cy="290" r="0.5" style="stroke:#000000"/> -<circle cx="131" cy="298" r="0.5" style="stroke:#000000"/> -<circle cx="151" cy="307" r="0.5" style="stroke:#000000"/> -<circle cx="151" cy="300" r="0.5" style="stroke:#000000"/> -<circle cx="120" cy="299" r="0.5" style="stroke:#000000"/> -<circle cx="147" cy="314" r="0.5" style="stroke:#000000"/> -<circle cx="141" cy="305" r="0.5" style="stroke:#000000"/> -<circle cx="141" cy="290" r="0.5" style="stroke:#000000"/> -<circle cx="167" cy="324" r="0.5" style="stroke:#000000"/> -<circle cx="140" cy="283" r="0.5" style="stroke:#000000"/> -<circle cx="158" cy="279" r="0.5" style="stroke:#000000"/> -<circle cx="155" cy="284" r="0.5" style="stroke:#000000"/> -<circle cx="172" cy="299" r="0.5" style="stroke:#000000"/> -<circle cx="156" cy="323" r="0.5" style="stroke:#000000"/> -<circle cx="164" cy="286" r="0.5" style="stroke:#000000"/> -<circle cx="156" cy="284" r="0.5" style="stroke:#000000"/> -<circle cx="146" cy="298" r="0.5" style="stroke:#000000"/> -<circle cx="140" cy="286" r="0.5" style="stroke:#000000"/> -<circle cx="133" cy="300" r="0.5" style="stroke:#000000"/> -<circle cx="148" cy="304" r="0.5" style="stroke:#000000"/> -<circle cx="149" cy="300" r="0.5" style="stroke:#000000"/> -<circle cx="143" cy="322" r="0.5" style="stroke:#000000"/> -<circle cx="141" cy="280" r="0.5" style="stroke:#000000"/> -<circle cx="152" cy="307" r="0.5" style="stroke:#000000"/> -<circle cx="149" cy="322" r="0.5" style="stroke:#000000"/> -<circle cx="151" cy="308" r="0.5" style="stroke:#000000"/> -<circle cx="143" cy="296" r="0.5" style="stroke:#000000"/> -<circle cx="167" cy="323" r="0.5" style="stroke:#000000"/> -<circle cx="154" cy="298" r="0.5" style="stroke:#000000"/> -<circle cx="139" cy="308" r="0.5" style="stroke:#000000"/> -<circle cx="151" cy="299" r="0.5" style="stroke:#000000"/> -<circle cx="150" cy="298" r="0.5" style="stroke:#000000"/> -<circle cx="148" cy="324" r="0.5" style="stroke:#000000"/> -<circle cx="150" cy="301" r="0.5" style="stroke:#000000"/> -<circle cx="146" cy="302" r="0.5" style="stroke:#000000"/> -<circle cx="149" cy="300" r="0.5" style="stroke:#000000"/> -<circle cx="139" cy="314" r="0.5" style="stroke:#000000"/> -<circle cx="168" cy="313" r="0.5" style="stroke:#000000"/> -<circle cx="156" cy="275" r="0.5" style="stroke:#000000"/> -<circle cx="148" cy="321" r="0.5" style="stroke:#000000"/> -<circle cx="152" cy="296" r="0.5" style="stroke:#000000"/> -<circle cx="150" cy="294" r="0.5" style="stroke:#000000"/> -<circle cx="147" cy="305" r="0.5" style="stroke:#000000"/> -<circle cx="148" cy="299" r="0.5" style="stroke:#000000"/> -<circle cx="155" cy="302" r="0.5" style="stroke:#000000"/> -<circle cx="139" cy="301" r="0.5" style="stroke:#000000"/> -<circle cx="155" cy="301" r="0.5" style="stroke:#000000"/> -<circle cx="147" cy="301" r="0.5" style="stroke:#000000"/> -<circle cx="129" cy="313" r="0.5" style="stroke:#000000"/> -<circle cx="169" cy="323" r="0.5" style="stroke:#000000"/> -<circle cx="151" cy="301" r="0.5" style="stroke:#000000"/> -<circle cx="147" cy="302" r="0.5" style="stroke:#000000"/> -<circle cx="177" cy="305" r="0.5" style="stroke:#000000"/> -<circle cx="165" cy="292" r="0.5" style="stroke:#000000"/> -<circle cx="150" cy="300" r="0.5" style="stroke:#000000"/> -<circle cx="139" cy="294" r="0.5" style="stroke:#000000"/> -<circle cx="162" cy="318" r="0.5" style="stroke:#000000"/> -<circle cx="150" cy="300" r="0.5" style="stroke:#000000"/> -<circle cx="150" cy="299" r="0.5" style="stroke:#000000"/> -<circle cx="130" cy="310" r="0.5" style="stroke:#000000"/> -<circle cx="155" cy="302" r="0.5" style="stroke:#000000"/> -<circle cx="160" cy="306" r="0.5" style="stroke:#000000"/> -<circle cx="158" cy="294" r="0.5" style="stroke:#000000"/> -<circle cx="160" cy="291" r="0.5" style="stroke:#000000"/> -<circle cx="158" cy="279" r="0.5" style="stroke:#000000"/> -<circle cx="130" cy="289" r="0.5" style="stroke:#000000"/> -<circle cx="141" cy="295" r="0.5" style="stroke:#000000"/> -<circle cx="152" cy="295" r="0.5" style="stroke:#000000"/> -<circle cx="142" cy="297" r="0.5" style="stroke:#000000"/> -<circle cx="168" cy="309" r="0.5" style="stroke:#000000"/> -<circle cx="155" cy="302" r="0.5" style="stroke:#000000"/> -<circle cx="132" cy="295" r="0.5" style="stroke:#000000"/> -<circle cx="150" cy="300" r="0.5" style="stroke:#000000"/> -<circle cx="163" cy="293" r="0.5" style="stroke:#000000"/> -<circle cx="144" cy="284" r="0.5" style="stroke:#000000"/> -<circle cx="149" cy="290" r="0.5" style="stroke:#000000"/> -<circle cx="146" cy="301" r="0.5" style="stroke:#000000"/> -<circle cx="139" cy="322" r="0.5" style="stroke:#000000"/> -<circle cx="163" cy="286" r="0.5" style="stroke:#000000"/> -<circle cx="142" cy="307" r="0.5" style="stroke:#000000"/> -<circle cx="164" cy="286" r="0.5" style="stroke:#000000"/> -<circle cx="153" cy="325" r="0.5" style="stroke:#000000"/> -<circle cx="147" cy="289" r="0.5" style="stroke:#000000"/> -<circle cx="138" cy="299" r="0.5" style="stroke:#000000"/> -<circle cx="157" cy="306" r="0.5" style="stroke:#000000"/> -<circle cx="158" cy="286" r="0.5" style="stroke:#000000"/> -<circle cx="144" cy="281" r="0.5" style="stroke:#000000"/> -<circle cx="150" cy="280" r="0.5" style="stroke:#000000"/> -<circle cx="151" cy="299" r="0.5" style="stroke:#000000"/> -<circle cx="169" cy="321" r="0.5" style="stroke:#000000"/> -<circle cx="132" cy="305" r="0.5" style="stroke:#000000"/> -<circle cx="153" cy="295" r="0.5" style="stroke:#000000"/> -<circle cx="178" cy="297" r="0.5" style="stroke:#000000"/> -<circle cx="179" cy="295" r="0.5" style="stroke:#000000"/> -<circle cx="149" cy="298" r="0.5" style="stroke:#000000"/> -<circle cx="146" cy="297" r="0.5" style="stroke:#000000"/> -<circle cx="132" cy="290" r="0.5" style="stroke:#000000"/> -<circle cx="153" cy="296" r="0.5" style="stroke:#000000"/> -<circle cx="154" cy="298" r="0.5" style="stroke:#000000"/> -<circle cx="136" cy="293" r="0.5" style="stroke:#000000"/> -<circle cx="175" cy="308" r="0.5" style="stroke:#000000"/> -<circle cx="167" cy="299" r="0.5" style="stroke:#000000"/> -<circle cx="154" cy="290" r="0.5" style="stroke:#000000"/> -<circle cx="133" cy="316" r="0.5" style="stroke:#000000"/> -<circle cx="127" cy="286" r="0.5" style="stroke:#000000"/> -<circle cx="139" cy="292" r="0.5" style="stroke:#000000"/> -<circle cx="148" cy="300" r="0.5" style="stroke:#000000"/> -<circle cx="157" cy="291" r="0.5" style="stroke:#000000"/> -<circle cx="144" cy="273" r="0.5" style="stroke:#000000"/> -<circle cx="131" cy="298" r="0.5" style="stroke:#000000"/> -<circle cx="160" cy="276" r="0.5" style="stroke:#000000"/> -<circle cx="142" cy="317" r="0.5" style="stroke:#000000"/> -<circle cx="148" cy="298" r="0.5" style="stroke:#000000"/> -<circle cx="150" cy="300" r="0.5" style="stroke:#000000"/> -<circle cx="161" cy="318" r="0.5" style="stroke:#000000"/> -<circle cx="150" cy="300" r="0.5" style="stroke:#000000"/> -<circle cx="134" cy="286" r="0.5" style="stroke:#000000"/> -<circle cx="135" cy="309" r="0.5" style="stroke:#000000"/> -<circle cx="129" cy="289" r="0.5" style="stroke:#000000"/> -<circle cx="147" cy="295" r="0.5" style="stroke:#000000"/> -<circle cx="176" cy="300" r="0.5" style="stroke:#000000"/> -<circle cx="145" cy="303" r="0.5" style="stroke:#000000"/> -<circle cx="132" cy="286" r="0.5" style="stroke:#000000"/> -<circle cx="148" cy="299" r="0.5" style="stroke:#000000"/> -<circle cx="152" cy="296" r="0.5" style="stroke:#000000"/> -<circle cx="124" cy="311" r="0.5" style="stroke:#000000"/> -<circle cx="176" cy="302" r="0.5" style="stroke:#000000"/> -<circle cx="148" cy="297" r="0.5" style="stroke:#000000"/> -<circle cx="134" cy="301" r="0.5" style="stroke:#000000"/> -<circle cx="136" cy="316" r="0.5" style="stroke:#000000"/> -<circle cx="148" cy="298" r="0.5" style="stroke:#000000"/> -<circle cx="148" cy="311" r="0.5" style="stroke:#000000"/> -<circle cx="139" cy="322" r="0.5" style="stroke:#000000"/> -<circle cx="159" cy="285" r="0.5" style="stroke:#000000"/> -<circle cx="125" cy="316" r="0.5" style="stroke:#000000"/> -<circle cx="148" cy="328" r="0.5" style="stroke:#000000"/> -<circle cx="178" cy="306" r="0.5" style="stroke:#000000"/> -<circle cx="138" cy="297" r="0.5" style="stroke:#000000"/> -<circle cx="140" cy="284" r="0.5" style="stroke:#000000"/> -<circle cx="173" cy="297" r="0.5" style="stroke:#000000"/> -<circle cx="138" cy="289" r="0.5" style="stroke:#000000"/> -<circle cx="167" cy="287" r="0.5" style="stroke:#000000"/> -<circle cx="495" cy="113" r="0.5" style="stroke:#000000"/> -<circle cx="509" cy="122" r="0.5" style="stroke:#000000"/> -<circle cx="491" cy="135" r="0.5" style="stroke:#000000"/> -<circle cx="487" cy="145" r="0.5" style="stroke:#000000"/> -<circle cx="497" cy="121" r="0.5" style="stroke:#000000"/> -<circle cx="502" cy="142" r="0.5" style="stroke:#000000"/> -<circle cx="515" cy="113" r="0.5" style="stroke:#000000"/> -<circle cx="513" cy="113" r="0.5" style="stroke:#000000"/> -<circle cx="491" cy="105" r="0.5" style="stroke:#000000"/> -<circle cx="509" cy="129" r="0.5" style="stroke:#000000"/> -<circle cx="514" cy="107" r="0.5" style="stroke:#000000"/> -<circle cx="500" cy="120" r="0.5" style="stroke:#000000"/> -<circle cx="504" cy="119" r="0.5" style="stroke:#000000"/> -<circle cx="504" cy="142" r="0.5" style="stroke:#000000"/> -<circle cx="488" cy="126" r="0.5" style="stroke:#000000"/> -<circle cx="515" cy="142" r="0.5" style="stroke:#000000"/> -<circle cx="501" cy="121" r="0.5" style="stroke:#000000"/> -<circle cx="500" cy="115" r="0.5" style="stroke:#000000"/> -<circle cx="500" cy="120" r="0.5" style="stroke:#000000"/> -<circle cx="491" cy="116" r="0.5" style="stroke:#000000"/> -<circle cx="476" cy="112" r="0.5" style="stroke:#000000"/> -<circle cx="486" cy="112" r="0.5" style="stroke:#000000"/> -<circle cx="506" cy="95" r="0.5" style="stroke:#000000"/> -<circle cx="476" cy="112" r="0.5" style="stroke:#000000"/> -<circle cx="485" cy="109" r="0.5" style="stroke:#000000"/> -<circle cx="514" cy="129" r="0.5" style="stroke:#000000"/> -<circle cx="521" cy="136" r="0.5" style="stroke:#000000"/> -<circle cx="504" cy="129" r="0.5" style="stroke:#000000"/> -<circle cx="514" cy="146" r="0.5" style="stroke:#000000"/> -<circle cx="504" cy="103" r="0.5" style="stroke:#000000"/> -<circle cx="491" cy="124" r="0.5" style="stroke:#000000"/> -<circle cx="514" cy="146" r="0.5" style="stroke:#000000"/> -<circle cx="501" cy="108" r="0.5" style="stroke:#000000"/> -<circle cx="486" cy="132" r="0.5" style="stroke:#000000"/> -<circle cx="508" cy="112" r="0.5" style="stroke:#000000"/> -<circle cx="510" cy="122" r="0.5" style="stroke:#000000"/> -<circle cx="495" cy="137" r="0.5" style="stroke:#000000"/> -<circle cx="508" cy="128" r="0.5" style="stroke:#000000"/> -<circle cx="497" cy="115" r="0.5" style="stroke:#000000"/> -<circle cx="497" cy="135" r="0.5" style="stroke:#000000"/> -<circle cx="497" cy="112" r="0.5" style="stroke:#000000"/> -<circle cx="510" cy="124" r="0.5" style="stroke:#000000"/> -<circle cx="494" cy="112" r="0.5" style="stroke:#000000"/> -<circle cx="518" cy="115" r="0.5" style="stroke:#000000"/> -<circle cx="489" cy="114" r="0.5" style="stroke:#000000"/> -<circle cx="480" cy="112" r="0.5" style="stroke:#000000"/> -<circle cx="510" cy="100" r="0.5" style="stroke:#000000"/> -<circle cx="500" cy="120" r="0.5" style="stroke:#000000"/> -<circle cx="516" cy="143" r="0.5" style="stroke:#000000"/> -<circle cx="500" cy="119" r="0.5" style="stroke:#000000"/> -<circle cx="495" cy="127" r="0.5" style="stroke:#000000"/> -<circle cx="495" cy="117" r="0.5" style="stroke:#000000"/> -<circle cx="505" cy="116" r="0.5" style="stroke:#000000"/> -<circle cx="498" cy="114" r="0.5" style="stroke:#000000"/> -<circle cx="502" cy="121" r="0.5" style="stroke:#000000"/> -<circle cx="509" cy="131" r="0.5" style="stroke:#000000"/> -<circle cx="492" cy="120" r="0.5" style="stroke:#000000"/> -<circle cx="521" cy="137" r="0.5" style="stroke:#000000"/> -<circle cx="485" cy="110" r="0.5" style="stroke:#000000"/> -<circle cx="481" cy="118" r="0.5" style="stroke:#000000"/> -<circle cx="501" cy="127" r="0.5" style="stroke:#000000"/> -<circle cx="501" cy="120" r="0.5" style="stroke:#000000"/> -<circle cx="470" cy="119" r="0.5" style="stroke:#000000"/> -<circle cx="497" cy="134" r="0.5" style="stroke:#000000"/> -<circle cx="491" cy="125" r="0.5" style="stroke:#000000"/> -<circle cx="491" cy="110" r="0.5" style="stroke:#000000"/> -<circle cx="517" cy="144" r="0.5" style="stroke:#000000"/> -<circle cx="490" cy="103" r="0.5" style="stroke:#000000"/> -<circle cx="508" cy="99" r="0.5" style="stroke:#000000"/> -<circle cx="505" cy="104" r="0.5" style="stroke:#000000"/> -<circle cx="522" cy="119" r="0.5" style="stroke:#000000"/> -<circle cx="506" cy="143" r="0.5" style="stroke:#000000"/> -<circle cx="514" cy="106" r="0.5" style="stroke:#000000"/> -<circle cx="506" cy="104" r="0.5" style="stroke:#000000"/> -<circle cx="496" cy="118" r="0.5" style="stroke:#000000"/> -<circle cx="490" cy="106" r="0.5" style="stroke:#000000"/> -<circle cx="483" cy="120" r="0.5" style="stroke:#000000"/> -<circle cx="498" cy="124" r="0.5" style="stroke:#000000"/> -<circle cx="499" cy="120" r="0.5" style="stroke:#000000"/> -<circle cx="493" cy="142" r="0.5" style="stroke:#000000"/> -<circle cx="491" cy="100" r="0.5" style="stroke:#000000"/> -<circle cx="502" cy="127" r="0.5" style="stroke:#000000"/> -<circle cx="499" cy="142" r="0.5" style="stroke:#000000"/> -<circle cx="501" cy="128" r="0.5" style="stroke:#000000"/> -<circle cx="493" cy="116" r="0.5" style="stroke:#000000"/> -<circle cx="517" cy="143" r="0.5" style="stroke:#000000"/> -<circle cx="504" cy="118" r="0.5" style="stroke:#000000"/> -<circle cx="489" cy="128" r="0.5" style="stroke:#000000"/> -<circle cx="501" cy="119" r="0.5" style="stroke:#000000"/> -<circle cx="500" cy="118" r="0.5" style="stroke:#000000"/> -<circle cx="498" cy="144" r="0.5" style="stroke:#000000"/> -<circle cx="500" cy="121" r="0.5" style="stroke:#000000"/> -<circle cx="496" cy="122" r="0.5" style="stroke:#000000"/> -<circle cx="499" cy="120" r="0.5" style="stroke:#000000"/> -<circle cx="489" cy="134" r="0.5" style="stroke:#000000"/> -<circle cx="518" cy="133" r="0.5" style="stroke:#000000"/> -<circle cx="506" cy="95" r="0.5" style="stroke:#000000"/> -<circle cx="498" cy="141" r="0.5" style="stroke:#000000"/> -<circle cx="502" cy="116" r="0.5" style="stroke:#000000"/> -<circle cx="500" cy="114" r="0.5" style="stroke:#000000"/> -<circle cx="497" cy="125" r="0.5" style="stroke:#000000"/> -<circle cx="498" cy="119" r="0.5" style="stroke:#000000"/> -<circle cx="505" cy="122" r="0.5" style="stroke:#000000"/> -<circle cx="489" cy="121" r="0.5" style="stroke:#000000"/> -<circle cx="505" cy="121" r="0.5" style="stroke:#000000"/> -<circle cx="497" cy="121" r="0.5" style="stroke:#000000"/> -<circle cx="479" cy="133" r="0.5" style="stroke:#000000"/> -<circle cx="519" cy="143" r="0.5" style="stroke:#000000"/> -<circle cx="501" cy="121" r="0.5" style="stroke:#000000"/> -<circle cx="497" cy="122" r="0.5" style="stroke:#000000"/> -<circle cx="527" cy="125" r="0.5" style="stroke:#000000"/> -<circle cx="515" cy="112" r="0.5" style="stroke:#000000"/> -<circle cx="500" cy="120" r="0.5" style="stroke:#000000"/> -<circle cx="489" cy="114" r="0.5" style="stroke:#000000"/> -<circle cx="512" cy="138" r="0.5" style="stroke:#000000"/> -<circle cx="500" cy="120" r="0.5" style="stroke:#000000"/> -<circle cx="500" cy="119" r="0.5" style="stroke:#000000"/> -<circle cx="480" cy="130" r="0.5" style="stroke:#000000"/> -<circle cx="505" cy="122" r="0.5" style="stroke:#000000"/> -<circle cx="510" cy="126" r="0.5" style="stroke:#000000"/> -<circle cx="508" cy="114" r="0.5" style="stroke:#000000"/> -<circle cx="510" cy="111" r="0.5" style="stroke:#000000"/> -<circle cx="508" cy="99" r="0.5" style="stroke:#000000"/> -<circle cx="480" cy="109" r="0.5" style="stroke:#000000"/> -<circle cx="491" cy="115" r="0.5" style="stroke:#000000"/> -<circle cx="502" cy="115" r="0.5" style="stroke:#000000"/> -<circle cx="492" cy="117" r="0.5" style="stroke:#000000"/> -<circle cx="518" cy="129" r="0.5" style="stroke:#000000"/> -<circle cx="505" cy="122" r="0.5" style="stroke:#000000"/> -<circle cx="482" cy="115" r="0.5" style="stroke:#000000"/> -<circle cx="500" cy="120" r="0.5" style="stroke:#000000"/> -<circle cx="513" cy="113" r="0.5" style="stroke:#000000"/> -<circle cx="494" cy="104" r="0.5" style="stroke:#000000"/> -<circle cx="499" cy="110" r="0.5" style="stroke:#000000"/> -<circle cx="496" cy="121" r="0.5" style="stroke:#000000"/> -<circle cx="489" cy="142" r="0.5" style="stroke:#000000"/> -<circle cx="513" cy="106" r="0.5" style="stroke:#000000"/> -<circle cx="492" cy="127" r="0.5" style="stroke:#000000"/> -<circle cx="514" cy="106" r="0.5" style="stroke:#000000"/> -<circle cx="503" cy="145" r="0.5" style="stroke:#000000"/> -<circle cx="497" cy="109" r="0.5" style="stroke:#000000"/> -<circle cx="488" cy="119" r="0.5" style="stroke:#000000"/> -<circle cx="507" cy="126" r="0.5" style="stroke:#000000"/> -<circle cx="508" cy="106" r="0.5" style="stroke:#000000"/> -<circle cx="494" cy="101" r="0.5" style="stroke:#000000"/> -<circle cx="500" cy="100" r="0.5" style="stroke:#000000"/> -<circle cx="501" cy="119" r="0.5" style="stroke:#000000"/> -<circle cx="519" cy="141" r="0.5" style="stroke:#000000"/> -<circle cx="482" cy="125" r="0.5" style="stroke:#000000"/> -<circle cx="503" cy="115" r="0.5" style="stroke:#000000"/> -<circle cx="528" cy="117" r="0.5" style="stroke:#000000"/> -<circle cx="529" cy="115" r="0.5" style="stroke:#000000"/> -<circle cx="499" cy="118" r="0.5" style="stroke:#000000"/> -<circle cx="496" cy="117" r="0.5" style="stroke:#000000"/> -<circle cx="482" cy="110" r="0.5" style="stroke:#000000"/> -<circle cx="503" cy="116" r="0.5" style="stroke:#000000"/> -<circle cx="504" cy="118" r="0.5" style="stroke:#000000"/> -<circle cx="486" cy="113" r="0.5" style="stroke:#000000"/> -<circle cx="525" cy="128" r="0.5" style="stroke:#000000"/> -<circle cx="517" cy="119" r="0.5" style="stroke:#000000"/> -<circle cx="504" cy="110" r="0.5" style="stroke:#000000"/> -<circle cx="483" cy="136" r="0.5" style="stroke:#000000"/> -<circle cx="477" cy="106" r="0.5" style="stroke:#000000"/> -<circle cx="489" cy="112" r="0.5" style="stroke:#000000"/> -<circle cx="498" cy="120" r="0.5" style="stroke:#000000"/> -<circle cx="507" cy="111" r="0.5" style="stroke:#000000"/> -<circle cx="494" cy="93" r="0.5" style="stroke:#000000"/> -<circle cx="481" cy="118" r="0.5" style="stroke:#000000"/> -<circle cx="510" cy="96" r="0.5" style="stroke:#000000"/> -<circle cx="492" cy="137" r="0.5" style="stroke:#000000"/> -<circle cx="498" cy="118" r="0.5" style="stroke:#000000"/> -<circle cx="500" cy="120" r="0.5" style="stroke:#000000"/> -<circle cx="511" cy="138" r="0.5" style="stroke:#000000"/> -<circle cx="500" cy="120" r="0.5" style="stroke:#000000"/> -<circle cx="484" cy="106" r="0.5" style="stroke:#000000"/> -<circle cx="485" cy="129" r="0.5" style="stroke:#000000"/> -<circle cx="479" cy="109" r="0.5" style="stroke:#000000"/> -<circle cx="497" cy="115" r="0.5" style="stroke:#000000"/> -<circle cx="526" cy="120" r="0.5" style="stroke:#000000"/> -<circle cx="495" cy="123" r="0.5" style="stroke:#000000"/> -<circle cx="482" cy="106" r="0.5" style="stroke:#000000"/> -<circle cx="498" cy="119" r="0.5" style="stroke:#000000"/> -<circle cx="502" cy="116" r="0.5" style="stroke:#000000"/> -<circle cx="474" cy="131" r="0.5" style="stroke:#000000"/> -<circle cx="526" cy="122" r="0.5" style="stroke:#000000"/> -<circle cx="498" cy="117" r="0.5" style="stroke:#000000"/> -<circle cx="484" cy="121" r="0.5" style="stroke:#000000"/> -<circle cx="486" cy="136" r="0.5" style="stroke:#000000"/> -<circle cx="498" cy="118" r="0.5" style="stroke:#000000"/> -<circle cx="498" cy="131" r="0.5" style="stroke:#000000"/> -<circle cx="489" cy="142" r="0.5" style="stroke:#000000"/> -<circle cx="509" cy="105" r="0.5" style="stroke:#000000"/> -<circle cx="475" cy="136" r="0.5" style="stroke:#000000"/> -<circle cx="498" cy="148" r="0.5" style="stroke:#000000"/> -<circle cx="528" cy="126" r="0.5" style="stroke:#000000"/> -<circle cx="488" cy="117" r="0.5" style="stroke:#000000"/> -<circle cx="490" cy="104" r="0.5" style="stroke:#000000"/> -<circle cx="523" cy="117" r="0.5" style="stroke:#000000"/> -<circle cx="488" cy="109" r="0.5" style="stroke:#000000"/> -<circle cx="517" cy="107" r="0.5" style="stroke:#000000"/> -<circle cx="275" cy="163" r="0.5" style="stroke:#000000"/> -<circle cx="345" cy="212" r="0.5" style="stroke:#000000"/> -<circle cx="256" cy="277" r="0.5" style="stroke:#000000"/> -<circle cx="235" cy="324" r="0.5" style="stroke:#000000"/> -<circle cx="286" cy="206" r="0.5" style="stroke:#000000"/> -<circle cx="312" cy="311" r="0.5" style="stroke:#000000"/> -<circle cx="375" cy="163" r="0.5" style="stroke:#000000"/> -<circle cx="363" cy="164" r="0.5" style="stroke:#000000"/> -<circle cx="254" cy="126" r="0.5" style="stroke:#000000"/> -<circle cx="343" cy="243" r="0.5" style="stroke:#000000"/> -<circle cx="372" cy="133" r="0.5" style="stroke:#000000"/> -<circle cx="301" cy="201" r="0.5" style="stroke:#000000"/> -<circle cx="319" cy="193" r="0.5" style="stroke:#000000"/> -<circle cx="319" cy="311" r="0.5" style="stroke:#000000"/> -<circle cx="238" cy="232" r="0.5" style="stroke:#000000"/> -<circle cx="376" cy="310" r="0.5" style="stroke:#000000"/> -<circle cx="305" cy="203" r="0.5" style="stroke:#000000"/> -<circle cx="299" cy="177" r="0.5" style="stroke:#000000"/> -<circle cx="300" cy="201" r="0.5" style="stroke:#000000"/> -<circle cx="256" cy="179" r="0.5" style="stroke:#000000"/> -<circle cx="182" cy="162" r="0.5" style="stroke:#000000"/> -<circle cx="229" cy="158" r="0.5" style="stroke:#000000"/> -<circle cx="328" cy="75" r="0.5" style="stroke:#000000"/> -<circle cx="180" cy="161" r="0.5" style="stroke:#000000"/> -<circle cx="225" cy="144" r="0.5" style="stroke:#000000"/> -<circle cx="369" cy="245" r="0.5" style="stroke:#000000"/> -<circle cx="406" cy="282" r="0.5" style="stroke:#000000"/> -<circle cx="320" cy="245" r="0.5" style="stroke:#000000"/> -<circle cx="369" cy="328" r="0.5" style="stroke:#000000"/> -<circle cx="318" cy="115" r="0.5" style="stroke:#000000"/> -<circle cx="253" cy="221" r="0.5" style="stroke:#000000"/> -<circle cx="369" cy="332" r="0.5" style="stroke:#000000"/> -<circle cx="303" cy="140" r="0.5" style="stroke:#000000"/> -<circle cx="231" cy="259" r="0.5" style="stroke:#000000"/> -<circle cx="342" cy="159" r="0.5" style="stroke:#000000"/> -<circle cx="348" cy="208" r="0.5" style="stroke:#000000"/> -<circle cx="273" cy="283" r="0.5" style="stroke:#000000"/> -<circle cx="342" cy="241" r="0.5" style="stroke:#000000"/> -<circle cx="284" cy="177" r="0.5" style="stroke:#000000"/> -<circle cx="283" cy="276" r="0.5" style="stroke:#000000"/> -<circle cx="284" cy="159" r="0.5" style="stroke:#000000"/> -<circle cx="348" cy="222" r="0.5" style="stroke:#000000"/> -<circle cx="269" cy="159" r="0.5" style="stroke:#000000"/> -<circle cx="388" cy="175" r="0.5" style="stroke:#000000"/> -<circle cx="245" cy="172" r="0.5" style="stroke:#000000"/> -<circle cx="200" cy="158" r="0.5" style="stroke:#000000"/> -<circle cx="351" cy="99" r="0.5" style="stroke:#000000"/> -<circle cx="300" cy="201" r="0.5" style="stroke:#000000"/> -<circle cx="379" cy="317" r="0.5" style="stroke:#000000"/> -<circle cx="301" cy="197" r="0.5" style="stroke:#000000"/> -<circle cx="277" cy="236" r="0.5" style="stroke:#000000"/> -<circle cx="275" cy="187" r="0.5" style="stroke:#000000"/> -<circle cx="324" cy="178" r="0.5" style="stroke:#000000"/> -<circle cx="292" cy="168" r="0.5" style="stroke:#000000"/> -<circle cx="312" cy="204" r="0.5" style="stroke:#000000"/> -<circle cx="345" cy="255" r="0.5" style="stroke:#000000"/> -<circle cx="262" cy="198" r="0.5" style="stroke:#000000"/> -<circle cx="403" cy="283" r="0.5" style="stroke:#000000"/> -<circle cx="223" cy="152" r="0.5" style="stroke:#000000"/> -<circle cx="207" cy="189" r="0.5" style="stroke:#000000"/> -<circle cx="305" cy="237" r="0.5" style="stroke:#000000"/> -<circle cx="303" cy="200" r="0.5" style="stroke:#000000"/> -<circle cx="150" cy="197" r="0.5" style="stroke:#000000"/> -<circle cx="286" cy="268" r="0.5" style="stroke:#000000"/> -<circle cx="254" cy="227" r="0.5" style="stroke:#000000"/> -<circle cx="254" cy="152" r="0.5" style="stroke:#000000"/> -<circle cx="387" cy="322" r="0.5" style="stroke:#000000"/> -<circle cx="250" cy="117" r="0.5" style="stroke:#000000"/> -<circle cx="341" cy="97" r="0.5" style="stroke:#000000"/> -<circle cx="327" cy="122" r="0.5" style="stroke:#000000"/> -<circle cx="412" cy="193" r="0.5" style="stroke:#000000"/> -<circle cx="329" cy="315" r="0.5" style="stroke:#000000"/> -<circle cx="372" cy="130" r="0.5" style="stroke:#000000"/> -<circle cx="328" cy="120" r="0.5" style="stroke:#000000"/> -<circle cx="279" cy="190" r="0.5" style="stroke:#000000"/> -<circle cx="248" cy="132" r="0.5" style="stroke:#000000"/> -<circle cx="213" cy="199" r="0.5" style="stroke:#000000"/> -<circle cx="291" cy="218" r="0.5" style="stroke:#000000"/> -<circle cx="297" cy="200" r="0.5" style="stroke:#000000"/> -<circle cx="264" cy="309" r="0.5" style="stroke:#000000"/> -<circle cx="257" cy="100" r="0.5" style="stroke:#000000"/> -<circle cx="308" cy="235" r="0.5" style="stroke:#000000"/> -<circle cx="296" cy="312" r="0.5" style="stroke:#000000"/> -<circle cx="305" cy="240" r="0.5" style="stroke:#000000"/> -<circle cx="264" cy="178" r="0.5" style="stroke:#000000"/> -<circle cx="383" cy="317" r="0.5" style="stroke:#000000"/> -<circle cx="319" cy="189" r="0.5" style="stroke:#000000"/> -<circle cx="247" cy="241" r="0.5" style="stroke:#000000"/> -<circle cx="306" cy="193" r="0.5" style="stroke:#000000"/> -<circle cx="302" cy="190" r="0.5" style="stroke:#000000"/> -<circle cx="292" cy="319" r="0.5" style="stroke:#000000"/> -<circle cx="298" cy="203" r="0.5" style="stroke:#000000"/> -<circle cx="280" cy="211" r="0.5" style="stroke:#000000"/> -<circle cx="296" cy="202" r="0.5" style="stroke:#000000"/> -<circle cx="243" cy="272" r="0.5" style="stroke:#000000"/> -<circle cx="392" cy="263" r="0.5" style="stroke:#000000"/> -<circle cx="331" cy="74" r="0.5" style="stroke:#000000"/> -<circle cx="292" cy="303" r="0.5" style="stroke:#000000"/> -<circle cx="310" cy="181" r="0.5" style="stroke:#000000"/> -<circle cx="302" cy="168" r="0.5" style="stroke:#000000"/> -<circle cx="287" cy="227" r="0.5" style="stroke:#000000"/> -<circle cx="288" cy="196" r="0.5" style="stroke:#000000"/> -<circle cx="326" cy="210" r="0.5" style="stroke:#000000"/> -<circle cx="244" cy="206" r="0.5" style="stroke:#000000"/> -<circle cx="325" cy="205" r="0.5" style="stroke:#000000"/> -<circle cx="287" cy="206" r="0.5" style="stroke:#000000"/> -<circle cx="194" cy="265" r="0.5" style="stroke:#000000"/> -<circle cx="397" cy="314" r="0.5" style="stroke:#000000"/> -<circle cx="307" cy="204" r="0.5" style="stroke:#000000"/> -<circle cx="286" cy="212" r="0.5" style="stroke:#000000"/> -<circle cx="436" cy="227" r="0.5" style="stroke:#000000"/> -<circle cx="373" cy="161" r="0.5" style="stroke:#000000"/> -<circle cx="298" cy="199" r="0.5" style="stroke:#000000"/> -<circle cx="244" cy="172" r="0.5" style="stroke:#000000"/> -<circle cx="360" cy="290" r="0.5" style="stroke:#000000"/> -<circle cx="299" cy="202" r="0.5" style="stroke:#000000"/> -<circle cx="300" cy="195" r="0.5" style="stroke:#000000"/> -<circle cx="201" cy="252" r="0.5" style="stroke:#000000"/> -<circle cx="323" cy="210" r="0.5" style="stroke:#000000"/> -<circle cx="350" cy="228" r="0.5" style="stroke:#000000"/> -<circle cx="341" cy="170" r="0.5" style="stroke:#000000"/> -<circle cx="349" cy="157" r="0.5" style="stroke:#000000"/> -<circle cx="340" cy="94" r="0.5" style="stroke:#000000"/> -<circle cx="202" cy="147" r="0.5" style="stroke:#000000"/> -<circle cx="254" cy="174" r="0.5" style="stroke:#000000"/> -<circle cx="309" cy="176" r="0.5" style="stroke:#000000"/> -<circle cx="260" cy="183" r="0.5" style="stroke:#000000"/> -<circle cx="391" cy="243" r="0.5" style="stroke:#000000"/> -<circle cx="326" cy="210" r="0.5" style="stroke:#000000"/> -<circle cx="210" cy="175" r="0.5" style="stroke:#000000"/> -<circle cx="300" cy="200" r="0.5" style="stroke:#000000"/> -<circle cx="364" cy="163" r="0.5" style="stroke:#000000"/> -<circle cx="271" cy="121" r="0.5" style="stroke:#000000"/> -<circle cx="294" cy="149" r="0.5" style="stroke:#000000"/> -<circle cx="278" cy="205" r="0.5" style="stroke:#000000"/> -<circle cx="245" cy="311" r="0.5" style="stroke:#000000"/> -<circle cx="363" cy="131" r="0.5" style="stroke:#000000"/> -<circle cx="262" cy="236" r="0.5" style="stroke:#000000"/> -<circle cx="369" cy="128" r="0.5" style="stroke:#000000"/> -<circle cx="317" cy="327" r="0.5" style="stroke:#000000"/> -<circle cx="283" cy="143" r="0.5" style="stroke:#000000"/> -<circle cx="239" cy="194" r="0.5" style="stroke:#000000"/> -<circle cx="333" cy="231" r="0.5" style="stroke:#000000"/> -<circle cx="340" cy="129" r="0.5" style="stroke:#000000"/> -<circle cx="271" cy="105" r="0.5" style="stroke:#000000"/> -<circle cx="302" cy="100" r="0.5" style="stroke:#000000"/> -<circle cx="303" cy="197" r="0.5" style="stroke:#000000"/> -<circle cx="395" cy="303" r="0.5" style="stroke:#000000"/> -<circle cx="210" cy="227" r="0.5" style="stroke:#000000"/> -<circle cx="317" cy="174" r="0.5" style="stroke:#000000"/> -<circle cx="441" cy="184" r="0.5" style="stroke:#000000"/> -<circle cx="447" cy="175" r="0.5" style="stroke:#000000"/> -<circle cx="294" cy="191" r="0.5" style="stroke:#000000"/> -<circle cx="281" cy="184" r="0.5" style="stroke:#000000"/> -<circle cx="212" cy="148" r="0.5" style="stroke:#000000"/> -<circle cx="315" cy="179" r="0.5" style="stroke:#000000"/> -<circle cx="318" cy="190" r="0.5" style="stroke:#000000"/> -<circle cx="232" cy="164" r="0.5" style="stroke:#000000"/> -<circle cx="425" cy="239" r="0.5" style="stroke:#000000"/> -<circle cx="387" cy="195" r="0.5" style="stroke:#000000"/> -<circle cx="322" cy="152" r="0.5" style="stroke:#000000"/> -<circle cx="213" cy="278" r="0.5" style="stroke:#000000"/> -<circle cx="187" cy="132" r="0.5" style="stroke:#000000"/> -<circle cx="245" cy="161" r="0.5" style="stroke:#000000"/> -<circle cx="292" cy="202" r="0.5" style="stroke:#000000"/> -<circle cx="336" cy="155" r="0.5" style="stroke:#000000"/> -<circle cx="272" cy="65" r="0.5" style="stroke:#000000"/> -<circle cx="204" cy="190" r="0.5" style="stroke:#000000"/> -<circle cx="351" cy="82" r="0.5" style="stroke:#000000"/> -<circle cx="259" cy="284" r="0.5" style="stroke:#000000"/> -<circle cx="288" cy="189" r="0.5" style="stroke:#000000"/> -<circle cx="300" cy="200" r="0.5" style="stroke:#000000"/> -<circle cx="353" cy="288" r="0.5" style="stroke:#000000"/> -<circle cx="301" cy="199" r="0.5" style="stroke:#000000"/> -<circle cx="218" cy="128" r="0.5" style="stroke:#000000"/> -<circle cx="226" cy="243" r="0.5" style="stroke:#000000"/> -<circle cx="195" cy="146" r="0.5" style="stroke:#000000"/> -<circle cx="284" cy="174" r="0.5" style="stroke:#000000"/> -<circle cx="428" cy="200" r="0.5" style="stroke:#000000"/> -<circle cx="274" cy="214" r="0.5" style="stroke:#000000"/> -<circle cx="211" cy="131" r="0.5" style="stroke:#000000"/> -<circle cx="291" cy="196" r="0.5" style="stroke:#000000"/> -<circle cx="310" cy="180" r="0.5" style="stroke:#000000"/> -<circle cx="172" cy="257" r="0.5" style="stroke:#000000"/> -<circle cx="431" cy="212" r="0.5" style="stroke:#000000"/> -<circle cx="290" cy="187" r="0.5" style="stroke:#000000"/> -<circle cx="219" cy="203" r="0.5" style="stroke:#000000"/> -<circle cx="230" cy="279" r="0.5" style="stroke:#000000"/> -<circle cx="291" cy="192" r="0.5" style="stroke:#000000"/> -<circle cx="291" cy="254" r="0.5" style="stroke:#000000"/> -<circle cx="245" cy="309" r="0.5" style="stroke:#000000"/> -<circle cx="345" cy="126" r="0.5" style="stroke:#000000"/> -<circle cx="175" cy="278" r="0.5" style="stroke:#000000"/> -<circle cx="289" cy="338" r="0.5" style="stroke:#000000"/> -<circle cx="442" cy="228" r="0.5" style="stroke:#000000"/> -<circle cx="242" cy="186" r="0.5" style="stroke:#000000"/> -<circle cx="249" cy="120" r="0.5" style="stroke:#000000"/> -<circle cx="415" cy="186" r="0.5" style="stroke:#000000"/> -<circle cx="242" cy="145" r="0.5" style="stroke:#000000"/> -<circle cx="384" cy="133" r="0.5" style="stroke:#000000"/> -<circle cx="20" cy="98" r="1" style="stroke:#ff0000"/> -<circle cx="50" cy="246" r="1" style="stroke:#ff0000"/> -<circle cx="83" cy="354" r="1" style="stroke:#ff0000"/> -<circle cx="164" cy="416" r="1" style="stroke:#ff0000"/> -<circle cx="236" cy="434" r="1" style="stroke:#ff0000"/> -<circle cx="343" cy="427" r="1" style="stroke:#ff0000"/> -<circle cx="366" cy="412" r="1" style="stroke:#ff0000"/> -<circle cx="379" cy="402" r="1" style="stroke:#ff0000"/> -<circle cx="519" cy="143" r="1" style="stroke:#ff0000"/> -<circle cx="528" cy="126" r="1" style="stroke:#ff0000"/> -<circle cx="529" cy="115" r="1" style="stroke:#ff0000"/> -<circle cx="510" cy="96" r="1" style="stroke:#ff0000"/> -<circle cx="506" cy="95" r="1" style="stroke:#ff0000"/> -<circle cx="117" cy="33" r="1" style="stroke:#ff0000"/> -<circle cx="85" cy="28" r="1" style="stroke:#ff0000"/> -<circle cx="40" cy="64" r="1" style="stroke:#ff0000"/> -</svg> diff --git a/testsuite/tests/dph/quickhull/dph-quickhull-vseg-fast.stdout b/testsuite/tests/dph/quickhull/dph-quickhull-vseg-fast.stdout deleted file mode 100644 index f6b2d92e9a..0000000000 --- a/testsuite/tests/dph/quickhull/dph-quickhull-vseg-fast.stdout +++ /dev/null @@ -1,1019 +0,0 @@ -<svg width="100%" height="100%" version="1.1" xmlns="http://www.w3.org/2000/svg"> -<polygon points="20,98 50,246 83,354 164,416 236,434 343,427 366,412 379,402 519,143 528,126 529,115 510,96 506,95 117,33 85,28 40,64 " style="fill:#d0d0ff;stroke:#000000;stroke-width:1"/> -<circle cx="217" cy="201" r="0.5" style="stroke:#000000"/> -<circle cx="310" cy="266" r="0.5" style="stroke:#000000"/> -<circle cx="191" cy="353" r="0.5" style="stroke:#000000"/> -<circle cx="164" cy="416" r="0.5" style="stroke:#000000"/> -<circle cx="232" cy="257" r="0.5" style="stroke:#000000"/> -<circle cx="266" cy="398" r="0.5" style="stroke:#000000"/> -<circle cx="350" cy="201" r="0.5" style="stroke:#000000"/> -<circle cx="334" cy="202" r="0.5" style="stroke:#000000"/> -<circle cx="189" cy="151" r="0.5" style="stroke:#000000"/> -<circle cx="308" cy="307" r="0.5" style="stroke:#000000"/> -<circle cx="347" cy="160" r="0.5" style="stroke:#000000"/> -<circle cx="251" cy="251" r="0.5" style="stroke:#000000"/> -<circle cx="275" cy="241" r="0.5" style="stroke:#000000"/> -<circle cx="275" cy="398" r="0.5" style="stroke:#000000"/> -<circle cx="167" cy="292" r="0.5" style="stroke:#000000"/> -<circle cx="351" cy="397" r="0.5" style="stroke:#000000"/> -<circle cx="257" cy="254" r="0.5" style="stroke:#000000"/> -<circle cx="248" cy="220" r="0.5" style="stroke:#000000"/> -<circle cx="250" cy="252" r="0.5" style="stroke:#000000"/> -<circle cx="191" cy="222" r="0.5" style="stroke:#000000"/> -<circle cx="93" cy="200" r="0.5" style="stroke:#000000"/> -<circle cx="155" cy="195" r="0.5" style="stroke:#000000"/> -<circle cx="287" cy="84" r="0.5" style="stroke:#000000"/> -<circle cx="90" cy="198" r="0.5" style="stroke:#000000"/> -<circle cx="149" cy="175" r="0.5" style="stroke:#000000"/> -<circle cx="342" cy="311" r="0.5" style="stroke:#000000"/> -<circle cx="391" cy="360" r="0.5" style="stroke:#000000"/> -<circle cx="277" cy="310" r="0.5" style="stroke:#000000"/> -<circle cx="341" cy="421" r="0.5" style="stroke:#000000"/> -<circle cx="274" cy="136" r="0.5" style="stroke:#000000"/> -<circle cx="187" cy="278" r="0.5" style="stroke:#000000"/> -<circle cx="343" cy="427" r="0.5" style="stroke:#000000"/> -<circle cx="255" cy="170" r="0.5" style="stroke:#000000"/> -<circle cx="158" cy="329" r="0.5" style="stroke:#000000"/> -<circle cx="306" cy="196" r="0.5" style="stroke:#000000"/> -<circle cx="315" cy="261" r="0.5" style="stroke:#000000"/> -<circle cx="214" cy="361" r="0.5" style="stroke:#000000"/> -<circle cx="306" cy="304" r="0.5" style="stroke:#000000"/> -<circle cx="229" cy="219" r="0.5" style="stroke:#000000"/> -<circle cx="227" cy="351" r="0.5" style="stroke:#000000"/> -<circle cx="228" cy="196" r="0.5" style="stroke:#000000"/> -<circle cx="314" cy="280" r="0.5" style="stroke:#000000"/> -<circle cx="209" cy="195" r="0.5" style="stroke:#000000"/> -<circle cx="367" cy="217" r="0.5" style="stroke:#000000"/> -<circle cx="176" cy="212" r="0.5" style="stroke:#000000"/> -<circle cx="117" cy="194" r="0.5" style="stroke:#000000"/> -<circle cx="318" cy="116" r="0.5" style="stroke:#000000"/> -<circle cx="250" cy="251" r="0.5" style="stroke:#000000"/> -<circle cx="355" cy="406" r="0.5" style="stroke:#000000"/> -<circle cx="252" cy="246" r="0.5" style="stroke:#000000"/> -<circle cx="219" cy="299" r="0.5" style="stroke:#000000"/> -<circle cx="217" cy="232" r="0.5" style="stroke:#000000"/> -<circle cx="283" cy="220" r="0.5" style="stroke:#000000"/> -<circle cx="239" cy="207" r="0.5" style="stroke:#000000"/> -<circle cx="266" cy="255" r="0.5" style="stroke:#000000"/> -<circle cx="310" cy="324" r="0.5" style="stroke:#000000"/> -<circle cx="200" cy="248" r="0.5" style="stroke:#000000"/> -<circle cx="387" cy="360" r="0.5" style="stroke:#000000"/> -<circle cx="147" cy="186" r="0.5" style="stroke:#000000"/> -<circle cx="126" cy="236" r="0.5" style="stroke:#000000"/> -<circle cx="257" cy="300" r="0.5" style="stroke:#000000"/> -<circle cx="255" cy="250" r="0.5" style="stroke:#000000"/> -<circle cx="50" cy="246" r="0.5" style="stroke:#000000"/> -<circle cx="231" cy="340" r="0.5" style="stroke:#000000"/> -<circle cx="189" cy="287" r="0.5" style="stroke:#000000"/> -<circle cx="188" cy="186" r="0.5" style="stroke:#000000"/> -<circle cx="366" cy="412" r="0.5" style="stroke:#000000"/> -<circle cx="183" cy="139" r="0.5" style="stroke:#000000"/> -<circle cx="305" cy="113" r="0.5" style="stroke:#000000"/> -<circle cx="286" cy="146" r="0.5" style="stroke:#000000"/> -<circle cx="399" cy="241" r="0.5" style="stroke:#000000"/> -<circle cx="289" cy="404" r="0.5" style="stroke:#000000"/> -<circle cx="346" cy="157" r="0.5" style="stroke:#000000"/> -<circle cx="287" cy="143" r="0.5" style="stroke:#000000"/> -<circle cx="223" cy="236" r="0.5" style="stroke:#000000"/> -<circle cx="181" cy="159" r="0.5" style="stroke:#000000"/> -<circle cx="134" cy="249" r="0.5" style="stroke:#000000"/> -<circle cx="238" cy="274" r="0.5" style="stroke:#000000"/> -<circle cx="246" cy="250" r="0.5" style="stroke:#000000"/> -<circle cx="201" cy="395" r="0.5" style="stroke:#000000"/> -<circle cx="192" cy="116" r="0.5" style="stroke:#000000"/> -<circle cx="260" cy="296" r="0.5" style="stroke:#000000"/> -<circle cx="244" cy="399" r="0.5" style="stroke:#000000"/> -<circle cx="256" cy="303" r="0.5" style="stroke:#000000"/> -<circle cx="202" cy="221" r="0.5" style="stroke:#000000"/> -<circle cx="361" cy="406" r="0.5" style="stroke:#000000"/> -<circle cx="275" cy="235" r="0.5" style="stroke:#000000"/> -<circle cx="180" cy="305" r="0.5" style="stroke:#000000"/> -<circle cx="258" cy="241" r="0.5" style="stroke:#000000"/> -<circle cx="253" cy="237" r="0.5" style="stroke:#000000"/> -<circle cx="239" cy="408" r="0.5" style="stroke:#000000"/> -<circle cx="247" cy="254" r="0.5" style="stroke:#000000"/> -<circle cx="223" cy="265" r="0.5" style="stroke:#000000"/> -<circle cx="244" cy="253" r="0.5" style="stroke:#000000"/> -<circle cx="174" cy="346" r="0.5" style="stroke:#000000"/> -<circle cx="373" cy="334" r="0.5" style="stroke:#000000"/> -<circle cx="292" cy="82" r="0.5" style="stroke:#000000"/> -<circle cx="240" cy="388" r="0.5" style="stroke:#000000"/> -<circle cx="263" cy="225" r="0.5" style="stroke:#000000"/> -<circle cx="252" cy="207" r="0.5" style="stroke:#000000"/> -<circle cx="233" cy="287" r="0.5" style="stroke:#000000"/> -<circle cx="234" cy="245" r="0.5" style="stroke:#000000"/> -<circle cx="285" cy="264" r="0.5" style="stroke:#000000"/> -<circle cx="176" cy="259" r="0.5" style="stroke:#000000"/> -<circle cx="284" cy="256" r="0.5" style="stroke:#000000"/> -<circle cx="233" cy="258" r="0.5" style="stroke:#000000"/> -<circle cx="108" cy="336" r="0.5" style="stroke:#000000"/> -<circle cx="379" cy="402" r="0.5" style="stroke:#000000"/> -<circle cx="260" cy="256" r="0.5" style="stroke:#000000"/> -<circle cx="232" cy="265" r="0.5" style="stroke:#000000"/> -<circle cx="432" cy="286" r="0.5" style="stroke:#000000"/> -<circle cx="347" cy="197" r="0.5" style="stroke:#000000"/> -<circle cx="248" cy="249" r="0.5" style="stroke:#000000"/> -<circle cx="176" cy="213" r="0.5" style="stroke:#000000"/> -<circle cx="330" cy="370" r="0.5" style="stroke:#000000"/> -<circle cx="249" cy="253" r="0.5" style="stroke:#000000"/> -<circle cx="249" cy="243" r="0.5" style="stroke:#000000"/> -<circle cx="119" cy="320" r="0.5" style="stroke:#000000"/> -<circle cx="280" cy="263" r="0.5" style="stroke:#000000"/> -<circle cx="317" cy="287" r="0.5" style="stroke:#000000"/> -<circle cx="304" cy="209" r="0.5" style="stroke:#000000"/> -<circle cx="315" cy="193" r="0.5" style="stroke:#000000"/> -<circle cx="304" cy="109" r="0.5" style="stroke:#000000"/> -<circle cx="119" cy="179" r="0.5" style="stroke:#000000"/> -<circle cx="188" cy="215" r="0.5" style="stroke:#000000"/> -<circle cx="263" cy="218" r="0.5" style="stroke:#000000"/> -<circle cx="196" cy="228" r="0.5" style="stroke:#000000"/> -<circle cx="371" cy="307" r="0.5" style="stroke:#000000"/> -<circle cx="285" cy="263" r="0.5" style="stroke:#000000"/> -<circle cx="130" cy="217" r="0.5" style="stroke:#000000"/> -<circle cx="250" cy="250" r="0.5" style="stroke:#000000"/> -<circle cx="335" cy="201" r="0.5" style="stroke:#000000"/> -<circle cx="211" cy="145" r="0.5" style="stroke:#000000"/> -<circle cx="242" cy="182" r="0.5" style="stroke:#000000"/> -<circle cx="221" cy="256" r="0.5" style="stroke:#000000"/> -<circle cx="177" cy="398" r="0.5" style="stroke:#000000"/> -<circle cx="333" cy="158" r="0.5" style="stroke:#000000"/> -<circle cx="199" cy="297" r="0.5" style="stroke:#000000"/> -<circle cx="342" cy="153" r="0.5" style="stroke:#000000"/> -<circle cx="273" cy="419" r="0.5" style="stroke:#000000"/> -<circle cx="227" cy="173" r="0.5" style="stroke:#000000"/> -<circle cx="169" cy="242" r="0.5" style="stroke:#000000"/> -<circle cx="294" cy="292" r="0.5" style="stroke:#000000"/> -<circle cx="303" cy="155" r="0.5" style="stroke:#000000"/> -<circle cx="211" cy="124" r="0.5" style="stroke:#000000"/> -<circle cx="253" cy="116" r="0.5" style="stroke:#000000"/> -<circle cx="254" cy="246" r="0.5" style="stroke:#000000"/> -<circle cx="377" cy="388" r="0.5" style="stroke:#000000"/> -<circle cx="130" cy="285" r="0.5" style="stroke:#000000"/> -<circle cx="273" cy="215" r="0.5" style="stroke:#000000"/> -<circle cx="438" cy="229" r="0.5" style="stroke:#000000"/> -<circle cx="446" cy="216" r="0.5" style="stroke:#000000"/> -<circle cx="242" cy="238" r="0.5" style="stroke:#000000"/> -<circle cx="224" cy="229" r="0.5" style="stroke:#000000"/> -<circle cx="133" cy="181" r="0.5" style="stroke:#000000"/> -<circle cx="270" cy="222" r="0.5" style="stroke:#000000"/> -<circle cx="275" cy="237" r="0.5" style="stroke:#000000"/> -<circle cx="160" cy="202" r="0.5" style="stroke:#000000"/> -<circle cx="416" cy="302" r="0.5" style="stroke:#000000"/> -<circle cx="366" cy="244" r="0.5" style="stroke:#000000"/> -<circle cx="279" cy="186" r="0.5" style="stroke:#000000"/> -<circle cx="134" cy="353" r="0.5" style="stroke:#000000"/> -<circle cx="99" cy="159" r="0.5" style="stroke:#000000"/> -<circle cx="177" cy="198" r="0.5" style="stroke:#000000"/> -<circle cx="239" cy="253" r="0.5" style="stroke:#000000"/> -<circle cx="298" cy="190" r="0.5" style="stroke:#000000"/> -<circle cx="213" cy="70" r="0.5" style="stroke:#000000"/> -<circle cx="122" cy="236" r="0.5" style="stroke:#000000"/> -<circle cx="318" cy="92" r="0.5" style="stroke:#000000"/> -<circle cx="196" cy="362" r="0.5" style="stroke:#000000"/> -<circle cx="234" cy="235" r="0.5" style="stroke:#000000"/> -<circle cx="250" cy="250" r="0.5" style="stroke:#000000"/> -<circle cx="321" cy="367" r="0.5" style="stroke:#000000"/> -<circle cx="251" cy="249" r="0.5" style="stroke:#000000"/> -<circle cx="141" cy="154" r="0.5" style="stroke:#000000"/> -<circle cx="152" cy="308" r="0.5" style="stroke:#000000"/> -<circle cx="110" cy="178" r="0.5" style="stroke:#000000"/> -<circle cx="229" cy="216" r="0.5" style="stroke:#000000"/> -<circle cx="421" cy="250" r="0.5" style="stroke:#000000"/> -<circle cx="215" cy="269" r="0.5" style="stroke:#000000"/> -<circle cx="131" cy="157" r="0.5" style="stroke:#000000"/> -<circle cx="238" cy="245" r="0.5" style="stroke:#000000"/> -<circle cx="264" cy="224" r="0.5" style="stroke:#000000"/> -<circle cx="79" cy="327" r="0.5" style="stroke:#000000"/> -<circle cx="424" cy="266" r="0.5" style="stroke:#000000"/> -<circle cx="237" cy="232" r="0.5" style="stroke:#000000"/> -<circle cx="142" cy="253" r="0.5" style="stroke:#000000"/> -<circle cx="156" cy="355" r="0.5" style="stroke:#000000"/> -<circle cx="239" cy="239" r="0.5" style="stroke:#000000"/> -<circle cx="238" cy="322" r="0.5" style="stroke:#000000"/> -<circle cx="177" cy="396" r="0.5" style="stroke:#000000"/> -<circle cx="310" cy="152" r="0.5" style="stroke:#000000"/> -<circle cx="83" cy="354" r="0.5" style="stroke:#000000"/> -<circle cx="236" cy="434" r="0.5" style="stroke:#000000"/> -<circle cx="439" cy="287" r="0.5" style="stroke:#000000"/> -<circle cx="173" cy="232" r="0.5" style="stroke:#000000"/> -<circle cx="181" cy="143" r="0.5" style="stroke:#000000"/> -<circle cx="404" cy="232" r="0.5" style="stroke:#000000"/> -<circle cx="173" cy="177" r="0.5" style="stroke:#000000"/> -<circle cx="362" cy="161" r="0.5" style="stroke:#000000"/> -<circle cx="87" cy="81" r="0.5" style="stroke:#000000"/> -<circle cx="124" cy="106" r="0.5" style="stroke:#000000"/> -<circle cx="76" cy="141" r="0.5" style="stroke:#000000"/> -<circle cx="65" cy="166" r="0.5" style="stroke:#000000"/> -<circle cx="93" cy="103" r="0.5" style="stroke:#000000"/> -<circle cx="107" cy="159" r="0.5" style="stroke:#000000"/> -<circle cx="140" cy="80" r="0.5" style="stroke:#000000"/> -<circle cx="134" cy="81" r="0.5" style="stroke:#000000"/> -<circle cx="76" cy="60" r="0.5" style="stroke:#000000"/> -<circle cx="123" cy="123" r="0.5" style="stroke:#000000"/> -<circle cx="139" cy="64" r="0.5" style="stroke:#000000"/> -<circle cx="100" cy="100" r="0.5" style="stroke:#000000"/> -<circle cx="110" cy="96" r="0.5" style="stroke:#000000"/> -<circle cx="110" cy="159" r="0.5" style="stroke:#000000"/> -<circle cx="67" cy="117" r="0.5" style="stroke:#000000"/> -<circle cx="140" cy="159" r="0.5" style="stroke:#000000"/> -<circle cx="103" cy="101" r="0.5" style="stroke:#000000"/> -<circle cx="99" cy="88" r="0.5" style="stroke:#000000"/> -<circle cx="100" cy="101" r="0.5" style="stroke:#000000"/> -<circle cx="76" cy="89" r="0.5" style="stroke:#000000"/> -<circle cx="37" cy="80" r="0.5" style="stroke:#000000"/> -<circle cx="62" cy="78" r="0.5" style="stroke:#000000"/> -<circle cx="115" cy="34" r="0.5" style="stroke:#000000"/> -<circle cx="36" cy="79" r="0.5" style="stroke:#000000"/> -<circle cx="60" cy="70" r="0.5" style="stroke:#000000"/> -<circle cx="137" cy="124" r="0.5" style="stroke:#000000"/> -<circle cx="156" cy="144" r="0.5" style="stroke:#000000"/> -<circle cx="111" cy="124" r="0.5" style="stroke:#000000"/> -<circle cx="137" cy="168" r="0.5" style="stroke:#000000"/> -<circle cx="110" cy="55" r="0.5" style="stroke:#000000"/> -<circle cx="75" cy="111" r="0.5" style="stroke:#000000"/> -<circle cx="137" cy="171" r="0.5" style="stroke:#000000"/> -<circle cx="102" cy="68" r="0.5" style="stroke:#000000"/> -<circle cx="63" cy="131" r="0.5" style="stroke:#000000"/> -<circle cx="122" cy="78" r="0.5" style="stroke:#000000"/> -<circle cx="126" cy="104" r="0.5" style="stroke:#000000"/> -<circle cx="86" cy="144" r="0.5" style="stroke:#000000"/> -<circle cx="123" cy="122" r="0.5" style="stroke:#000000"/> -<circle cx="92" cy="88" r="0.5" style="stroke:#000000"/> -<circle cx="91" cy="140" r="0.5" style="stroke:#000000"/> -<circle cx="91" cy="78" r="0.5" style="stroke:#000000"/> -<circle cx="126" cy="112" r="0.5" style="stroke:#000000"/> -<circle cx="84" cy="78" r="0.5" style="stroke:#000000"/> -<circle cx="147" cy="87" r="0.5" style="stroke:#000000"/> -<circle cx="70" cy="85" r="0.5" style="stroke:#000000"/> -<circle cx="47" cy="77" r="0.5" style="stroke:#000000"/> -<circle cx="127" cy="46" r="0.5" style="stroke:#000000"/> -<circle cx="100" cy="100" r="0.5" style="stroke:#000000"/> -<circle cx="142" cy="163" r="0.5" style="stroke:#000000"/> -<circle cx="101" cy="99" r="0.5" style="stroke:#000000"/> -<circle cx="88" cy="119" r="0.5" style="stroke:#000000"/> -<circle cx="87" cy="93" r="0.5" style="stroke:#000000"/> -<circle cx="113" cy="88" r="0.5" style="stroke:#000000"/> -<circle cx="96" cy="83" r="0.5" style="stroke:#000000"/> -<circle cx="106" cy="102" r="0.5" style="stroke:#000000"/> -<circle cx="124" cy="130" r="0.5" style="stroke:#000000"/> -<circle cx="80" cy="99" r="0.5" style="stroke:#000000"/> -<circle cx="155" cy="144" r="0.5" style="stroke:#000000"/> -<circle cx="59" cy="74" r="0.5" style="stroke:#000000"/> -<circle cx="50" cy="94" r="0.5" style="stroke:#000000"/> -<circle cx="103" cy="120" r="0.5" style="stroke:#000000"/> -<circle cx="102" cy="100" r="0.5" style="stroke:#000000"/> -<circle cx="20" cy="98" r="0.5" style="stroke:#000000"/> -<circle cx="92" cy="136" r="0.5" style="stroke:#000000"/> -<circle cx="75" cy="115" r="0.5" style="stroke:#000000"/> -<circle cx="75" cy="74" r="0.5" style="stroke:#000000"/> -<circle cx="146" cy="165" r="0.5" style="stroke:#000000"/> -<circle cx="73" cy="56" r="0.5" style="stroke:#000000"/> -<circle cx="122" cy="45" r="0.5" style="stroke:#000000"/> -<circle cx="115" cy="59" r="0.5" style="stroke:#000000"/> -<circle cx="160" cy="97" r="0.5" style="stroke:#000000"/> -<circle cx="116" cy="161" r="0.5" style="stroke:#000000"/> -<circle cx="139" cy="63" r="0.5" style="stroke:#000000"/> -<circle cx="115" cy="57" r="0.5" style="stroke:#000000"/> -<circle cx="89" cy="94" r="0.5" style="stroke:#000000"/> -<circle cx="72" cy="64" r="0.5" style="stroke:#000000"/> -<circle cx="53" cy="99" r="0.5" style="stroke:#000000"/> -<circle cx="95" cy="110" r="0.5" style="stroke:#000000"/> -<circle cx="99" cy="100" r="0.5" style="stroke:#000000"/> -<circle cx="81" cy="158" r="0.5" style="stroke:#000000"/> -<circle cx="77" cy="46" r="0.5" style="stroke:#000000"/> -<circle cx="104" cy="118" r="0.5" style="stroke:#000000"/> -<circle cx="98" cy="160" r="0.5" style="stroke:#000000"/> -<circle cx="102" cy="121" r="0.5" style="stroke:#000000"/> -<circle cx="81" cy="88" r="0.5" style="stroke:#000000"/> -<circle cx="145" cy="163" r="0.5" style="stroke:#000000"/> -<circle cx="110" cy="94" r="0.5" style="stroke:#000000"/> -<circle cx="72" cy="122" r="0.5" style="stroke:#000000"/> -<circle cx="103" cy="96" r="0.5" style="stroke:#000000"/> -<circle cx="101" cy="95" r="0.5" style="stroke:#000000"/> -<circle cx="95" cy="163" r="0.5" style="stroke:#000000"/> -<circle cx="99" cy="101" r="0.5" style="stroke:#000000"/> -<circle cx="89" cy="106" r="0.5" style="stroke:#000000"/> -<circle cx="98" cy="101" r="0.5" style="stroke:#000000"/> -<circle cx="70" cy="138" r="0.5" style="stroke:#000000"/> -<circle cx="149" cy="134" r="0.5" style="stroke:#000000"/> -<circle cx="117" cy="33" r="0.5" style="stroke:#000000"/> -<circle cx="96" cy="155" r="0.5" style="stroke:#000000"/> -<circle cx="105" cy="90" r="0.5" style="stroke:#000000"/> -<circle cx="101" cy="83" r="0.5" style="stroke:#000000"/> -<circle cx="93" cy="115" r="0.5" style="stroke:#000000"/> -<circle cx="94" cy="98" r="0.5" style="stroke:#000000"/> -<circle cx="114" cy="105" r="0.5" style="stroke:#000000"/> -<circle cx="70" cy="103" r="0.5" style="stroke:#000000"/> -<circle cx="114" cy="103" r="0.5" style="stroke:#000000"/> -<circle cx="93" cy="103" r="0.5" style="stroke:#000000"/> -<circle cx="43" cy="135" r="0.5" style="stroke:#000000"/> -<circle cx="152" cy="161" r="0.5" style="stroke:#000000"/> -<circle cx="104" cy="102" r="0.5" style="stroke:#000000"/> -<circle cx="93" cy="106" r="0.5" style="stroke:#000000"/> -<circle cx="173" cy="115" r="0.5" style="stroke:#000000"/> -<circle cx="139" cy="79" r="0.5" style="stroke:#000000"/> -<circle cx="99" cy="99" r="0.5" style="stroke:#000000"/> -<circle cx="70" cy="85" r="0.5" style="stroke:#000000"/> -<circle cx="132" cy="148" r="0.5" style="stroke:#000000"/> -<circle cx="99" cy="101" r="0.5" style="stroke:#000000"/> -<circle cx="100" cy="97" r="0.5" style="stroke:#000000"/> -<circle cx="47" cy="128" r="0.5" style="stroke:#000000"/> -<circle cx="112" cy="105" r="0.5" style="stroke:#000000"/> -<circle cx="127" cy="115" r="0.5" style="stroke:#000000"/> -<circle cx="122" cy="84" r="0.5" style="stroke:#000000"/> -<circle cx="126" cy="77" r="0.5" style="stroke:#000000"/> -<circle cx="121" cy="44" r="0.5" style="stroke:#000000"/> -<circle cx="48" cy="72" r="0.5" style="stroke:#000000"/> -<circle cx="75" cy="86" r="0.5" style="stroke:#000000"/> -<circle cx="105" cy="87" r="0.5" style="stroke:#000000"/> -<circle cx="79" cy="91" r="0.5" style="stroke:#000000"/> -<circle cx="148" cy="123" r="0.5" style="stroke:#000000"/> -<circle cx="114" cy="105" r="0.5" style="stroke:#000000"/> -<circle cx="52" cy="87" r="0.5" style="stroke:#000000"/> -<circle cx="100" cy="100" r="0.5" style="stroke:#000000"/> -<circle cx="134" cy="80" r="0.5" style="stroke:#000000"/> -<circle cx="84" cy="58" r="0.5" style="stroke:#000000"/> -<circle cx="97" cy="73" r="0.5" style="stroke:#000000"/> -<circle cx="88" cy="102" r="0.5" style="stroke:#000000"/> -<circle cx="71" cy="159" r="0.5" style="stroke:#000000"/> -<circle cx="133" cy="63" r="0.5" style="stroke:#000000"/> -<circle cx="80" cy="119" r="0.5" style="stroke:#000000"/> -<circle cx="137" cy="61" r="0.5" style="stroke:#000000"/> -<circle cx="109" cy="168" r="0.5" style="stroke:#000000"/> -<circle cx="91" cy="69" r="0.5" style="stroke:#000000"/> -<circle cx="68" cy="97" r="0.5" style="stroke:#000000"/> -<circle cx="117" cy="117" r="0.5" style="stroke:#000000"/> -<circle cx="121" cy="62" r="0.5" style="stroke:#000000"/> -<circle cx="84" cy="50" r="0.5" style="stroke:#000000"/> -<circle cx="101" cy="46" r="0.5" style="stroke:#000000"/> -<circle cx="102" cy="98" r="0.5" style="stroke:#000000"/> -<circle cx="151" cy="155" r="0.5" style="stroke:#000000"/> -<circle cx="52" cy="114" r="0.5" style="stroke:#000000"/> -<circle cx="109" cy="86" r="0.5" style="stroke:#000000"/> -<circle cx="175" cy="91" r="0.5" style="stroke:#000000"/> -<circle cx="178" cy="87" r="0.5" style="stroke:#000000"/> -<circle cx="97" cy="95" r="0.5" style="stroke:#000000"/> -<circle cx="90" cy="92" r="0.5" style="stroke:#000000"/> -<circle cx="53" cy="72" r="0.5" style="stroke:#000000"/> -<circle cx="108" cy="89" r="0.5" style="stroke:#000000"/> -<circle cx="110" cy="95" r="0.5" style="stroke:#000000"/> -<circle cx="64" cy="81" r="0.5" style="stroke:#000000"/> -<circle cx="166" cy="121" r="0.5" style="stroke:#000000"/> -<circle cx="146" cy="97" r="0.5" style="stroke:#000000"/> -<circle cx="112" cy="74" r="0.5" style="stroke:#000000"/> -<circle cx="54" cy="141" r="0.5" style="stroke:#000000"/> -<circle cx="40" cy="64" r="0.5" style="stroke:#000000"/> -<circle cx="71" cy="79" r="0.5" style="stroke:#000000"/> -<circle cx="96" cy="101" r="0.5" style="stroke:#000000"/> -<circle cx="119" cy="76" r="0.5" style="stroke:#000000"/> -<circle cx="85" cy="28" r="0.5" style="stroke:#000000"/> -<circle cx="49" cy="94" r="0.5" style="stroke:#000000"/> -<circle cx="127" cy="37" r="0.5" style="stroke:#000000"/> -<circle cx="78" cy="145" r="0.5" style="stroke:#000000"/> -<circle cx="94" cy="94" r="0.5" style="stroke:#000000"/> -<circle cx="100" cy="100" r="0.5" style="stroke:#000000"/> -<circle cx="128" cy="147" r="0.5" style="stroke:#000000"/> -<circle cx="101" cy="100" r="0.5" style="stroke:#000000"/> -<circle cx="56" cy="62" r="0.5" style="stroke:#000000"/> -<circle cx="61" cy="123" r="0.5" style="stroke:#000000"/> -<circle cx="44" cy="71" r="0.5" style="stroke:#000000"/> -<circle cx="92" cy="86" r="0.5" style="stroke:#000000"/> -<circle cx="169" cy="100" r="0.5" style="stroke:#000000"/> -<circle cx="86" cy="107" r="0.5" style="stroke:#000000"/> -<circle cx="52" cy="63" r="0.5" style="stroke:#000000"/> -<circle cx="95" cy="98" r="0.5" style="stroke:#000000"/> -<circle cx="106" cy="89" r="0.5" style="stroke:#000000"/> -<circle cx="32" cy="131" r="0.5" style="stroke:#000000"/> -<circle cx="170" cy="106" r="0.5" style="stroke:#000000"/> -<circle cx="95" cy="93" r="0.5" style="stroke:#000000"/> -<circle cx="57" cy="101" r="0.5" style="stroke:#000000"/> -<circle cx="62" cy="142" r="0.5" style="stroke:#000000"/> -<circle cx="95" cy="95" r="0.5" style="stroke:#000000"/> -<circle cx="95" cy="129" r="0.5" style="stroke:#000000"/> -<circle cx="71" cy="158" r="0.5" style="stroke:#000000"/> -<circle cx="124" cy="61" r="0.5" style="stroke:#000000"/> -<circle cx="33" cy="142" r="0.5" style="stroke:#000000"/> -<circle cx="94" cy="174" r="0.5" style="stroke:#000000"/> -<circle cx="176" cy="115" r="0.5" style="stroke:#000000"/> -<circle cx="69" cy="93" r="0.5" style="stroke:#000000"/> -<circle cx="73" cy="57" r="0.5" style="stroke:#000000"/> -<circle cx="162" cy="93" r="0.5" style="stroke:#000000"/> -<circle cx="69" cy="71" r="0.5" style="stroke:#000000"/> -<circle cx="145" cy="64" r="0.5" style="stroke:#000000"/> -<circle cx="145" cy="293" r="0.5" style="stroke:#000000"/> -<circle cx="159" cy="302" r="0.5" style="stroke:#000000"/> -<circle cx="141" cy="315" r="0.5" style="stroke:#000000"/> -<circle cx="137" cy="325" r="0.5" style="stroke:#000000"/> -<circle cx="147" cy="301" r="0.5" style="stroke:#000000"/> -<circle cx="152" cy="322" r="0.5" style="stroke:#000000"/> -<circle cx="165" cy="293" r="0.5" style="stroke:#000000"/> -<circle cx="163" cy="293" r="0.5" style="stroke:#000000"/> -<circle cx="141" cy="285" r="0.5" style="stroke:#000000"/> -<circle cx="159" cy="309" r="0.5" style="stroke:#000000"/> -<circle cx="164" cy="287" r="0.5" style="stroke:#000000"/> -<circle cx="150" cy="300" r="0.5" style="stroke:#000000"/> -<circle cx="154" cy="299" r="0.5" style="stroke:#000000"/> -<circle cx="154" cy="322" r="0.5" style="stroke:#000000"/> -<circle cx="138" cy="306" r="0.5" style="stroke:#000000"/> -<circle cx="165" cy="322" r="0.5" style="stroke:#000000"/> -<circle cx="151" cy="301" r="0.5" style="stroke:#000000"/> -<circle cx="150" cy="295" r="0.5" style="stroke:#000000"/> -<circle cx="150" cy="300" r="0.5" style="stroke:#000000"/> -<circle cx="141" cy="296" r="0.5" style="stroke:#000000"/> -<circle cx="126" cy="292" r="0.5" style="stroke:#000000"/> -<circle cx="136" cy="292" r="0.5" style="stroke:#000000"/> -<circle cx="156" cy="275" r="0.5" style="stroke:#000000"/> -<circle cx="126" cy="292" r="0.5" style="stroke:#000000"/> -<circle cx="135" cy="289" r="0.5" style="stroke:#000000"/> -<circle cx="164" cy="309" r="0.5" style="stroke:#000000"/> -<circle cx="171" cy="316" r="0.5" style="stroke:#000000"/> -<circle cx="154" cy="309" r="0.5" style="stroke:#000000"/> -<circle cx="164" cy="326" r="0.5" style="stroke:#000000"/> -<circle cx="154" cy="283" r="0.5" style="stroke:#000000"/> -<circle cx="141" cy="304" r="0.5" style="stroke:#000000"/> -<circle cx="164" cy="326" r="0.5" style="stroke:#000000"/> -<circle cx="151" cy="288" r="0.5" style="stroke:#000000"/> -<circle cx="136" cy="312" r="0.5" style="stroke:#000000"/> -<circle cx="158" cy="292" r="0.5" style="stroke:#000000"/> -<circle cx="160" cy="302" r="0.5" style="stroke:#000000"/> -<circle cx="145" cy="317" r="0.5" style="stroke:#000000"/> -<circle cx="158" cy="308" r="0.5" style="stroke:#000000"/> -<circle cx="147" cy="295" r="0.5" style="stroke:#000000"/> -<circle cx="147" cy="315" r="0.5" style="stroke:#000000"/> -<circle cx="147" cy="292" r="0.5" style="stroke:#000000"/> -<circle cx="160" cy="304" r="0.5" style="stroke:#000000"/> -<circle cx="144" cy="292" r="0.5" style="stroke:#000000"/> -<circle cx="168" cy="295" r="0.5" style="stroke:#000000"/> -<circle cx="139" cy="294" r="0.5" style="stroke:#000000"/> -<circle cx="130" cy="292" r="0.5" style="stroke:#000000"/> -<circle cx="160" cy="280" r="0.5" style="stroke:#000000"/> -<circle cx="150" cy="300" r="0.5" style="stroke:#000000"/> -<circle cx="166" cy="323" r="0.5" style="stroke:#000000"/> -<circle cx="150" cy="299" r="0.5" style="stroke:#000000"/> -<circle cx="145" cy="307" r="0.5" style="stroke:#000000"/> -<circle cx="145" cy="297" r="0.5" style="stroke:#000000"/> -<circle cx="155" cy="296" r="0.5" style="stroke:#000000"/> -<circle cx="148" cy="294" r="0.5" style="stroke:#000000"/> -<circle cx="152" cy="301" r="0.5" style="stroke:#000000"/> -<circle cx="159" cy="311" r="0.5" style="stroke:#000000"/> -<circle cx="142" cy="300" r="0.5" style="stroke:#000000"/> -<circle cx="171" cy="317" r="0.5" style="stroke:#000000"/> -<circle cx="135" cy="290" r="0.5" style="stroke:#000000"/> -<circle cx="131" cy="298" r="0.5" style="stroke:#000000"/> -<circle cx="151" cy="307" r="0.5" style="stroke:#000000"/> -<circle cx="151" cy="300" r="0.5" style="stroke:#000000"/> -<circle cx="120" cy="299" r="0.5" style="stroke:#000000"/> -<circle cx="147" cy="314" r="0.5" style="stroke:#000000"/> -<circle cx="141" cy="305" r="0.5" style="stroke:#000000"/> -<circle cx="141" cy="290" r="0.5" style="stroke:#000000"/> -<circle cx="167" cy="324" r="0.5" style="stroke:#000000"/> -<circle cx="140" cy="283" r="0.5" style="stroke:#000000"/> -<circle cx="158" cy="279" r="0.5" style="stroke:#000000"/> -<circle cx="155" cy="284" r="0.5" style="stroke:#000000"/> -<circle cx="172" cy="299" r="0.5" style="stroke:#000000"/> -<circle cx="156" cy="323" r="0.5" style="stroke:#000000"/> -<circle cx="164" cy="286" r="0.5" style="stroke:#000000"/> -<circle cx="156" cy="284" r="0.5" style="stroke:#000000"/> -<circle cx="146" cy="298" r="0.5" style="stroke:#000000"/> -<circle cx="140" cy="286" r="0.5" style="stroke:#000000"/> -<circle cx="133" cy="300" r="0.5" style="stroke:#000000"/> -<circle cx="148" cy="304" r="0.5" style="stroke:#000000"/> -<circle cx="149" cy="300" r="0.5" style="stroke:#000000"/> -<circle cx="143" cy="322" r="0.5" style="stroke:#000000"/> -<circle cx="141" cy="280" r="0.5" style="stroke:#000000"/> -<circle cx="152" cy="307" r="0.5" style="stroke:#000000"/> -<circle cx="149" cy="322" r="0.5" style="stroke:#000000"/> -<circle cx="151" cy="308" r="0.5" style="stroke:#000000"/> -<circle cx="143" cy="296" r="0.5" style="stroke:#000000"/> -<circle cx="167" cy="323" r="0.5" style="stroke:#000000"/> -<circle cx="154" cy="298" r="0.5" style="stroke:#000000"/> -<circle cx="139" cy="308" r="0.5" style="stroke:#000000"/> -<circle cx="151" cy="299" r="0.5" style="stroke:#000000"/> -<circle cx="150" cy="298" r="0.5" style="stroke:#000000"/> -<circle cx="148" cy="324" r="0.5" style="stroke:#000000"/> -<circle cx="150" cy="301" r="0.5" style="stroke:#000000"/> -<circle cx="146" cy="302" r="0.5" style="stroke:#000000"/> -<circle cx="149" cy="300" r="0.5" style="stroke:#000000"/> -<circle cx="139" cy="314" r="0.5" style="stroke:#000000"/> -<circle cx="168" cy="313" r="0.5" style="stroke:#000000"/> -<circle cx="156" cy="275" r="0.5" style="stroke:#000000"/> -<circle cx="148" cy="321" r="0.5" style="stroke:#000000"/> -<circle cx="152" cy="296" r="0.5" style="stroke:#000000"/> -<circle cx="150" cy="294" r="0.5" style="stroke:#000000"/> -<circle cx="147" cy="305" r="0.5" style="stroke:#000000"/> -<circle cx="148" cy="299" r="0.5" style="stroke:#000000"/> -<circle cx="155" cy="302" r="0.5" style="stroke:#000000"/> -<circle cx="139" cy="301" r="0.5" style="stroke:#000000"/> -<circle cx="155" cy="301" r="0.5" style="stroke:#000000"/> -<circle cx="147" cy="301" r="0.5" style="stroke:#000000"/> -<circle cx="129" cy="313" r="0.5" style="stroke:#000000"/> -<circle cx="169" cy="323" r="0.5" style="stroke:#000000"/> -<circle cx="151" cy="301" r="0.5" style="stroke:#000000"/> -<circle cx="147" cy="302" r="0.5" style="stroke:#000000"/> -<circle cx="177" cy="305" r="0.5" style="stroke:#000000"/> -<circle cx="165" cy="292" r="0.5" style="stroke:#000000"/> -<circle cx="150" cy="300" r="0.5" style="stroke:#000000"/> -<circle cx="139" cy="294" r="0.5" style="stroke:#000000"/> -<circle cx="162" cy="318" r="0.5" style="stroke:#000000"/> -<circle cx="150" cy="300" r="0.5" style="stroke:#000000"/> -<circle cx="150" cy="299" r="0.5" style="stroke:#000000"/> -<circle cx="130" cy="310" r="0.5" style="stroke:#000000"/> -<circle cx="155" cy="302" r="0.5" style="stroke:#000000"/> -<circle cx="160" cy="306" r="0.5" style="stroke:#000000"/> -<circle cx="158" cy="294" r="0.5" style="stroke:#000000"/> -<circle cx="160" cy="291" r="0.5" style="stroke:#000000"/> -<circle cx="158" cy="279" r="0.5" style="stroke:#000000"/> -<circle cx="130" cy="289" r="0.5" style="stroke:#000000"/> -<circle cx="141" cy="295" r="0.5" style="stroke:#000000"/> -<circle cx="152" cy="295" r="0.5" style="stroke:#000000"/> -<circle cx="142" cy="297" r="0.5" style="stroke:#000000"/> -<circle cx="168" cy="309" r="0.5" style="stroke:#000000"/> -<circle cx="155" cy="302" r="0.5" style="stroke:#000000"/> -<circle cx="132" cy="295" r="0.5" style="stroke:#000000"/> -<circle cx="150" cy="300" r="0.5" style="stroke:#000000"/> -<circle cx="163" cy="293" r="0.5" style="stroke:#000000"/> -<circle cx="144" cy="284" r="0.5" style="stroke:#000000"/> -<circle cx="149" cy="290" r="0.5" style="stroke:#000000"/> -<circle cx="146" cy="301" r="0.5" style="stroke:#000000"/> -<circle cx="139" cy="322" r="0.5" style="stroke:#000000"/> -<circle cx="163" cy="286" r="0.5" style="stroke:#000000"/> -<circle cx="142" cy="307" r="0.5" style="stroke:#000000"/> -<circle cx="164" cy="286" r="0.5" style="stroke:#000000"/> -<circle cx="153" cy="325" r="0.5" style="stroke:#000000"/> -<circle cx="147" cy="289" r="0.5" style="stroke:#000000"/> -<circle cx="138" cy="299" r="0.5" style="stroke:#000000"/> -<circle cx="157" cy="306" r="0.5" style="stroke:#000000"/> -<circle cx="158" cy="286" r="0.5" style="stroke:#000000"/> -<circle cx="144" cy="281" r="0.5" style="stroke:#000000"/> -<circle cx="150" cy="280" r="0.5" style="stroke:#000000"/> -<circle cx="151" cy="299" r="0.5" style="stroke:#000000"/> -<circle cx="169" cy="321" r="0.5" style="stroke:#000000"/> -<circle cx="132" cy="305" r="0.5" style="stroke:#000000"/> -<circle cx="153" cy="295" r="0.5" style="stroke:#000000"/> -<circle cx="178" cy="297" r="0.5" style="stroke:#000000"/> -<circle cx="179" cy="295" r="0.5" style="stroke:#000000"/> -<circle cx="149" cy="298" r="0.5" style="stroke:#000000"/> -<circle cx="146" cy="297" r="0.5" style="stroke:#000000"/> -<circle cx="132" cy="290" r="0.5" style="stroke:#000000"/> -<circle cx="153" cy="296" r="0.5" style="stroke:#000000"/> -<circle cx="154" cy="298" r="0.5" style="stroke:#000000"/> -<circle cx="136" cy="293" r="0.5" style="stroke:#000000"/> -<circle cx="175" cy="308" r="0.5" style="stroke:#000000"/> -<circle cx="167" cy="299" r="0.5" style="stroke:#000000"/> -<circle cx="154" cy="290" r="0.5" style="stroke:#000000"/> -<circle cx="133" cy="316" r="0.5" style="stroke:#000000"/> -<circle cx="127" cy="286" r="0.5" style="stroke:#000000"/> -<circle cx="139" cy="292" r="0.5" style="stroke:#000000"/> -<circle cx="148" cy="300" r="0.5" style="stroke:#000000"/> -<circle cx="157" cy="291" r="0.5" style="stroke:#000000"/> -<circle cx="144" cy="273" r="0.5" style="stroke:#000000"/> -<circle cx="131" cy="298" r="0.5" style="stroke:#000000"/> -<circle cx="160" cy="276" r="0.5" style="stroke:#000000"/> -<circle cx="142" cy="317" r="0.5" style="stroke:#000000"/> -<circle cx="148" cy="298" r="0.5" style="stroke:#000000"/> -<circle cx="150" cy="300" r="0.5" style="stroke:#000000"/> -<circle cx="161" cy="318" r="0.5" style="stroke:#000000"/> -<circle cx="150" cy="300" r="0.5" style="stroke:#000000"/> -<circle cx="134" cy="286" r="0.5" style="stroke:#000000"/> -<circle cx="135" cy="309" r="0.5" style="stroke:#000000"/> -<circle cx="129" cy="289" r="0.5" style="stroke:#000000"/> -<circle cx="147" cy="295" r="0.5" style="stroke:#000000"/> -<circle cx="176" cy="300" r="0.5" style="stroke:#000000"/> -<circle cx="145" cy="303" r="0.5" style="stroke:#000000"/> -<circle cx="132" cy="286" r="0.5" style="stroke:#000000"/> -<circle cx="148" cy="299" r="0.5" style="stroke:#000000"/> -<circle cx="152" cy="296" r="0.5" style="stroke:#000000"/> -<circle cx="124" cy="311" r="0.5" style="stroke:#000000"/> -<circle cx="176" cy="302" r="0.5" style="stroke:#000000"/> -<circle cx="148" cy="297" r="0.5" style="stroke:#000000"/> -<circle cx="134" cy="301" r="0.5" style="stroke:#000000"/> -<circle cx="136" cy="316" r="0.5" style="stroke:#000000"/> -<circle cx="148" cy="298" r="0.5" style="stroke:#000000"/> -<circle cx="148" cy="311" r="0.5" style="stroke:#000000"/> -<circle cx="139" cy="322" r="0.5" style="stroke:#000000"/> -<circle cx="159" cy="285" r="0.5" style="stroke:#000000"/> -<circle cx="125" cy="316" r="0.5" style="stroke:#000000"/> -<circle cx="148" cy="328" r="0.5" style="stroke:#000000"/> -<circle cx="178" cy="306" r="0.5" style="stroke:#000000"/> -<circle cx="138" cy="297" r="0.5" style="stroke:#000000"/> -<circle cx="140" cy="284" r="0.5" style="stroke:#000000"/> -<circle cx="173" cy="297" r="0.5" style="stroke:#000000"/> -<circle cx="138" cy="289" r="0.5" style="stroke:#000000"/> -<circle cx="167" cy="287" r="0.5" style="stroke:#000000"/> -<circle cx="495" cy="113" r="0.5" style="stroke:#000000"/> -<circle cx="509" cy="122" r="0.5" style="stroke:#000000"/> -<circle cx="491" cy="135" r="0.5" style="stroke:#000000"/> -<circle cx="487" cy="145" r="0.5" style="stroke:#000000"/> -<circle cx="497" cy="121" r="0.5" style="stroke:#000000"/> -<circle cx="502" cy="142" r="0.5" style="stroke:#000000"/> -<circle cx="515" cy="113" r="0.5" style="stroke:#000000"/> -<circle cx="513" cy="113" r="0.5" style="stroke:#000000"/> -<circle cx="491" cy="105" r="0.5" style="stroke:#000000"/> -<circle cx="509" cy="129" r="0.5" style="stroke:#000000"/> -<circle cx="514" cy="107" r="0.5" style="stroke:#000000"/> -<circle cx="500" cy="120" r="0.5" style="stroke:#000000"/> -<circle cx="504" cy="119" r="0.5" style="stroke:#000000"/> -<circle cx="504" cy="142" r="0.5" style="stroke:#000000"/> -<circle cx="488" cy="126" r="0.5" style="stroke:#000000"/> -<circle cx="515" cy="142" r="0.5" style="stroke:#000000"/> -<circle cx="501" cy="121" r="0.5" style="stroke:#000000"/> -<circle cx="500" cy="115" r="0.5" style="stroke:#000000"/> -<circle cx="500" cy="120" r="0.5" style="stroke:#000000"/> -<circle cx="491" cy="116" r="0.5" style="stroke:#000000"/> -<circle cx="476" cy="112" r="0.5" style="stroke:#000000"/> -<circle cx="486" cy="112" r="0.5" style="stroke:#000000"/> -<circle cx="506" cy="95" r="0.5" style="stroke:#000000"/> -<circle cx="476" cy="112" r="0.5" style="stroke:#000000"/> -<circle cx="485" cy="109" r="0.5" style="stroke:#000000"/> -<circle cx="514" cy="129" r="0.5" style="stroke:#000000"/> -<circle cx="521" cy="136" r="0.5" style="stroke:#000000"/> -<circle cx="504" cy="129" r="0.5" style="stroke:#000000"/> -<circle cx="514" cy="146" r="0.5" style="stroke:#000000"/> -<circle cx="504" cy="103" r="0.5" style="stroke:#000000"/> -<circle cx="491" cy="124" r="0.5" style="stroke:#000000"/> -<circle cx="514" cy="146" r="0.5" style="stroke:#000000"/> -<circle cx="501" cy="108" r="0.5" style="stroke:#000000"/> -<circle cx="486" cy="132" r="0.5" style="stroke:#000000"/> -<circle cx="508" cy="112" r="0.5" style="stroke:#000000"/> -<circle cx="510" cy="122" r="0.5" style="stroke:#000000"/> -<circle cx="495" cy="137" r="0.5" style="stroke:#000000"/> -<circle cx="508" cy="128" r="0.5" style="stroke:#000000"/> -<circle cx="497" cy="115" r="0.5" style="stroke:#000000"/> -<circle cx="497" cy="135" r="0.5" style="stroke:#000000"/> -<circle cx="497" cy="112" r="0.5" style="stroke:#000000"/> -<circle cx="510" cy="124" r="0.5" style="stroke:#000000"/> -<circle cx="494" cy="112" r="0.5" style="stroke:#000000"/> -<circle cx="518" cy="115" r="0.5" style="stroke:#000000"/> -<circle cx="489" cy="114" r="0.5" style="stroke:#000000"/> -<circle cx="480" cy="112" r="0.5" style="stroke:#000000"/> -<circle cx="510" cy="100" r="0.5" style="stroke:#000000"/> -<circle cx="500" cy="120" r="0.5" style="stroke:#000000"/> -<circle cx="516" cy="143" r="0.5" style="stroke:#000000"/> -<circle cx="500" cy="119" r="0.5" style="stroke:#000000"/> -<circle cx="495" cy="127" r="0.5" style="stroke:#000000"/> -<circle cx="495" cy="117" r="0.5" style="stroke:#000000"/> -<circle cx="505" cy="116" r="0.5" style="stroke:#000000"/> -<circle cx="498" cy="114" r="0.5" style="stroke:#000000"/> -<circle cx="502" cy="121" r="0.5" style="stroke:#000000"/> -<circle cx="509" cy="131" r="0.5" style="stroke:#000000"/> -<circle cx="492" cy="120" r="0.5" style="stroke:#000000"/> -<circle cx="521" cy="137" r="0.5" style="stroke:#000000"/> -<circle cx="485" cy="110" r="0.5" style="stroke:#000000"/> -<circle cx="481" cy="118" r="0.5" style="stroke:#000000"/> -<circle cx="501" cy="127" r="0.5" style="stroke:#000000"/> -<circle cx="501" cy="120" r="0.5" style="stroke:#000000"/> -<circle cx="470" cy="119" r="0.5" style="stroke:#000000"/> -<circle cx="497" cy="134" r="0.5" style="stroke:#000000"/> -<circle cx="491" cy="125" r="0.5" style="stroke:#000000"/> -<circle cx="491" cy="110" r="0.5" style="stroke:#000000"/> -<circle cx="517" cy="144" r="0.5" style="stroke:#000000"/> -<circle cx="490" cy="103" r="0.5" style="stroke:#000000"/> -<circle cx="508" cy="99" r="0.5" style="stroke:#000000"/> -<circle cx="505" cy="104" r="0.5" style="stroke:#000000"/> -<circle cx="522" cy="119" r="0.5" style="stroke:#000000"/> -<circle cx="506" cy="143" r="0.5" style="stroke:#000000"/> -<circle cx="514" cy="106" r="0.5" style="stroke:#000000"/> -<circle cx="506" cy="104" r="0.5" style="stroke:#000000"/> -<circle cx="496" cy="118" r="0.5" style="stroke:#000000"/> -<circle cx="490" cy="106" r="0.5" style="stroke:#000000"/> -<circle cx="483" cy="120" r="0.5" style="stroke:#000000"/> -<circle cx="498" cy="124" r="0.5" style="stroke:#000000"/> -<circle cx="499" cy="120" r="0.5" style="stroke:#000000"/> -<circle cx="493" cy="142" r="0.5" style="stroke:#000000"/> -<circle cx="491" cy="100" r="0.5" style="stroke:#000000"/> -<circle cx="502" cy="127" r="0.5" style="stroke:#000000"/> -<circle cx="499" cy="142" r="0.5" style="stroke:#000000"/> -<circle cx="501" cy="128" r="0.5" style="stroke:#000000"/> -<circle cx="493" cy="116" r="0.5" style="stroke:#000000"/> -<circle cx="517" cy="143" r="0.5" style="stroke:#000000"/> -<circle cx="504" cy="118" r="0.5" style="stroke:#000000"/> -<circle cx="489" cy="128" r="0.5" style="stroke:#000000"/> -<circle cx="501" cy="119" r="0.5" style="stroke:#000000"/> -<circle cx="500" cy="118" r="0.5" style="stroke:#000000"/> -<circle cx="498" cy="144" r="0.5" style="stroke:#000000"/> -<circle cx="500" cy="121" r="0.5" style="stroke:#000000"/> -<circle cx="496" cy="122" r="0.5" style="stroke:#000000"/> -<circle cx="499" cy="120" r="0.5" style="stroke:#000000"/> -<circle cx="489" cy="134" r="0.5" style="stroke:#000000"/> -<circle cx="518" cy="133" r="0.5" style="stroke:#000000"/> -<circle cx="506" cy="95" r="0.5" style="stroke:#000000"/> -<circle cx="498" cy="141" r="0.5" style="stroke:#000000"/> -<circle cx="502" cy="116" r="0.5" style="stroke:#000000"/> -<circle cx="500" cy="114" r="0.5" style="stroke:#000000"/> -<circle cx="497" cy="125" r="0.5" style="stroke:#000000"/> -<circle cx="498" cy="119" r="0.5" style="stroke:#000000"/> -<circle cx="505" cy="122" r="0.5" style="stroke:#000000"/> -<circle cx="489" cy="121" r="0.5" style="stroke:#000000"/> -<circle cx="505" cy="121" r="0.5" style="stroke:#000000"/> -<circle cx="497" cy="121" r="0.5" style="stroke:#000000"/> -<circle cx="479" cy="133" r="0.5" style="stroke:#000000"/> -<circle cx="519" cy="143" r="0.5" style="stroke:#000000"/> -<circle cx="501" cy="121" r="0.5" style="stroke:#000000"/> -<circle cx="497" cy="122" r="0.5" style="stroke:#000000"/> -<circle cx="527" cy="125" r="0.5" style="stroke:#000000"/> -<circle cx="515" cy="112" r="0.5" style="stroke:#000000"/> -<circle cx="500" cy="120" r="0.5" style="stroke:#000000"/> -<circle cx="489" cy="114" r="0.5" style="stroke:#000000"/> -<circle cx="512" cy="138" r="0.5" style="stroke:#000000"/> -<circle cx="500" cy="120" r="0.5" style="stroke:#000000"/> -<circle cx="500" cy="119" r="0.5" style="stroke:#000000"/> -<circle cx="480" cy="130" r="0.5" style="stroke:#000000"/> -<circle cx="505" cy="122" r="0.5" style="stroke:#000000"/> -<circle cx="510" cy="126" r="0.5" style="stroke:#000000"/> -<circle cx="508" cy="114" r="0.5" style="stroke:#000000"/> -<circle cx="510" cy="111" r="0.5" style="stroke:#000000"/> -<circle cx="508" cy="99" r="0.5" style="stroke:#000000"/> -<circle cx="480" cy="109" r="0.5" style="stroke:#000000"/> -<circle cx="491" cy="115" r="0.5" style="stroke:#000000"/> -<circle cx="502" cy="115" r="0.5" style="stroke:#000000"/> -<circle cx="492" cy="117" r="0.5" style="stroke:#000000"/> -<circle cx="518" cy="129" r="0.5" style="stroke:#000000"/> -<circle cx="505" cy="122" r="0.5" style="stroke:#000000"/> -<circle cx="482" cy="115" r="0.5" style="stroke:#000000"/> -<circle cx="500" cy="120" r="0.5" style="stroke:#000000"/> -<circle cx="513" cy="113" r="0.5" style="stroke:#000000"/> -<circle cx="494" cy="104" r="0.5" style="stroke:#000000"/> -<circle cx="499" cy="110" r="0.5" style="stroke:#000000"/> -<circle cx="496" cy="121" r="0.5" style="stroke:#000000"/> -<circle cx="489" cy="142" r="0.5" style="stroke:#000000"/> -<circle cx="513" cy="106" r="0.5" style="stroke:#000000"/> -<circle cx="492" cy="127" r="0.5" style="stroke:#000000"/> -<circle cx="514" cy="106" r="0.5" style="stroke:#000000"/> -<circle cx="503" cy="145" r="0.5" style="stroke:#000000"/> -<circle cx="497" cy="109" r="0.5" style="stroke:#000000"/> -<circle cx="488" cy="119" r="0.5" style="stroke:#000000"/> -<circle cx="507" cy="126" r="0.5" style="stroke:#000000"/> -<circle cx="508" cy="106" r="0.5" style="stroke:#000000"/> -<circle cx="494" cy="101" r="0.5" style="stroke:#000000"/> -<circle cx="500" cy="100" r="0.5" style="stroke:#000000"/> -<circle cx="501" cy="119" r="0.5" style="stroke:#000000"/> -<circle cx="519" cy="141" r="0.5" style="stroke:#000000"/> -<circle cx="482" cy="125" r="0.5" style="stroke:#000000"/> -<circle cx="503" cy="115" r="0.5" style="stroke:#000000"/> -<circle cx="528" cy="117" r="0.5" style="stroke:#000000"/> -<circle cx="529" cy="115" r="0.5" style="stroke:#000000"/> -<circle cx="499" cy="118" r="0.5" style="stroke:#000000"/> -<circle cx="496" cy="117" r="0.5" style="stroke:#000000"/> -<circle cx="482" cy="110" r="0.5" style="stroke:#000000"/> -<circle cx="503" cy="116" r="0.5" style="stroke:#000000"/> -<circle cx="504" cy="118" r="0.5" style="stroke:#000000"/> -<circle cx="486" cy="113" r="0.5" style="stroke:#000000"/> -<circle cx="525" cy="128" r="0.5" style="stroke:#000000"/> -<circle cx="517" cy="119" r="0.5" style="stroke:#000000"/> -<circle cx="504" cy="110" r="0.5" style="stroke:#000000"/> -<circle cx="483" cy="136" r="0.5" style="stroke:#000000"/> -<circle cx="477" cy="106" r="0.5" style="stroke:#000000"/> -<circle cx="489" cy="112" r="0.5" style="stroke:#000000"/> -<circle cx="498" cy="120" r="0.5" style="stroke:#000000"/> -<circle cx="507" cy="111" r="0.5" style="stroke:#000000"/> -<circle cx="494" cy="93" r="0.5" style="stroke:#000000"/> -<circle cx="481" cy="118" r="0.5" style="stroke:#000000"/> -<circle cx="510" cy="96" r="0.5" style="stroke:#000000"/> -<circle cx="492" cy="137" r="0.5" style="stroke:#000000"/> -<circle cx="498" cy="118" r="0.5" style="stroke:#000000"/> -<circle cx="500" cy="120" r="0.5" style="stroke:#000000"/> -<circle cx="511" cy="138" r="0.5" style="stroke:#000000"/> -<circle cx="500" cy="120" r="0.5" style="stroke:#000000"/> -<circle cx="484" cy="106" r="0.5" style="stroke:#000000"/> -<circle cx="485" cy="129" r="0.5" style="stroke:#000000"/> -<circle cx="479" cy="109" r="0.5" style="stroke:#000000"/> -<circle cx="497" cy="115" r="0.5" style="stroke:#000000"/> -<circle cx="526" cy="120" r="0.5" style="stroke:#000000"/> -<circle cx="495" cy="123" r="0.5" style="stroke:#000000"/> -<circle cx="482" cy="106" r="0.5" style="stroke:#000000"/> -<circle cx="498" cy="119" r="0.5" style="stroke:#000000"/> -<circle cx="502" cy="116" r="0.5" style="stroke:#000000"/> -<circle cx="474" cy="131" r="0.5" style="stroke:#000000"/> -<circle cx="526" cy="122" r="0.5" style="stroke:#000000"/> -<circle cx="498" cy="117" r="0.5" style="stroke:#000000"/> -<circle cx="484" cy="121" r="0.5" style="stroke:#000000"/> -<circle cx="486" cy="136" r="0.5" style="stroke:#000000"/> -<circle cx="498" cy="118" r="0.5" style="stroke:#000000"/> -<circle cx="498" cy="131" r="0.5" style="stroke:#000000"/> -<circle cx="489" cy="142" r="0.5" style="stroke:#000000"/> -<circle cx="509" cy="105" r="0.5" style="stroke:#000000"/> -<circle cx="475" cy="136" r="0.5" style="stroke:#000000"/> -<circle cx="498" cy="148" r="0.5" style="stroke:#000000"/> -<circle cx="528" cy="126" r="0.5" style="stroke:#000000"/> -<circle cx="488" cy="117" r="0.5" style="stroke:#000000"/> -<circle cx="490" cy="104" r="0.5" style="stroke:#000000"/> -<circle cx="523" cy="117" r="0.5" style="stroke:#000000"/> -<circle cx="488" cy="109" r="0.5" style="stroke:#000000"/> -<circle cx="517" cy="107" r="0.5" style="stroke:#000000"/> -<circle cx="275" cy="163" r="0.5" style="stroke:#000000"/> -<circle cx="345" cy="212" r="0.5" style="stroke:#000000"/> -<circle cx="256" cy="277" r="0.5" style="stroke:#000000"/> -<circle cx="235" cy="324" r="0.5" style="stroke:#000000"/> -<circle cx="286" cy="206" r="0.5" style="stroke:#000000"/> -<circle cx="312" cy="311" r="0.5" style="stroke:#000000"/> -<circle cx="375" cy="163" r="0.5" style="stroke:#000000"/> -<circle cx="363" cy="164" r="0.5" style="stroke:#000000"/> -<circle cx="254" cy="126" r="0.5" style="stroke:#000000"/> -<circle cx="343" cy="243" r="0.5" style="stroke:#000000"/> -<circle cx="372" cy="133" r="0.5" style="stroke:#000000"/> -<circle cx="301" cy="201" r="0.5" style="stroke:#000000"/> -<circle cx="319" cy="193" r="0.5" style="stroke:#000000"/> -<circle cx="319" cy="311" r="0.5" style="stroke:#000000"/> -<circle cx="238" cy="232" r="0.5" style="stroke:#000000"/> -<circle cx="376" cy="310" r="0.5" style="stroke:#000000"/> -<circle cx="305" cy="203" r="0.5" style="stroke:#000000"/> -<circle cx="299" cy="177" r="0.5" style="stroke:#000000"/> -<circle cx="300" cy="201" r="0.5" style="stroke:#000000"/> -<circle cx="256" cy="179" r="0.5" style="stroke:#000000"/> -<circle cx="182" cy="162" r="0.5" style="stroke:#000000"/> -<circle cx="229" cy="158" r="0.5" style="stroke:#000000"/> -<circle cx="328" cy="75" r="0.5" style="stroke:#000000"/> -<circle cx="180" cy="161" r="0.5" style="stroke:#000000"/> -<circle cx="225" cy="144" r="0.5" style="stroke:#000000"/> -<circle cx="369" cy="245" r="0.5" style="stroke:#000000"/> -<circle cx="406" cy="282" r="0.5" style="stroke:#000000"/> -<circle cx="320" cy="245" r="0.5" style="stroke:#000000"/> -<circle cx="369" cy="328" r="0.5" style="stroke:#000000"/> -<circle cx="318" cy="115" r="0.5" style="stroke:#000000"/> -<circle cx="253" cy="221" r="0.5" style="stroke:#000000"/> -<circle cx="369" cy="332" r="0.5" style="stroke:#000000"/> -<circle cx="303" cy="140" r="0.5" style="stroke:#000000"/> -<circle cx="231" cy="259" r="0.5" style="stroke:#000000"/> -<circle cx="342" cy="159" r="0.5" style="stroke:#000000"/> -<circle cx="348" cy="208" r="0.5" style="stroke:#000000"/> -<circle cx="273" cy="283" r="0.5" style="stroke:#000000"/> -<circle cx="342" cy="241" r="0.5" style="stroke:#000000"/> -<circle cx="284" cy="177" r="0.5" style="stroke:#000000"/> -<circle cx="283" cy="276" r="0.5" style="stroke:#000000"/> -<circle cx="284" cy="159" r="0.5" style="stroke:#000000"/> -<circle cx="348" cy="222" r="0.5" style="stroke:#000000"/> -<circle cx="269" cy="159" r="0.5" style="stroke:#000000"/> -<circle cx="388" cy="175" r="0.5" style="stroke:#000000"/> -<circle cx="245" cy="172" r="0.5" style="stroke:#000000"/> -<circle cx="200" cy="158" r="0.5" style="stroke:#000000"/> -<circle cx="351" cy="99" r="0.5" style="stroke:#000000"/> -<circle cx="300" cy="201" r="0.5" style="stroke:#000000"/> -<circle cx="379" cy="317" r="0.5" style="stroke:#000000"/> -<circle cx="301" cy="197" r="0.5" style="stroke:#000000"/> -<circle cx="277" cy="236" r="0.5" style="stroke:#000000"/> -<circle cx="275" cy="187" r="0.5" style="stroke:#000000"/> -<circle cx="324" cy="178" r="0.5" style="stroke:#000000"/> -<circle cx="292" cy="168" r="0.5" style="stroke:#000000"/> -<circle cx="312" cy="204" r="0.5" style="stroke:#000000"/> -<circle cx="345" cy="255" r="0.5" style="stroke:#000000"/> -<circle cx="262" cy="198" r="0.5" style="stroke:#000000"/> -<circle cx="403" cy="283" r="0.5" style="stroke:#000000"/> -<circle cx="223" cy="152" r="0.5" style="stroke:#000000"/> -<circle cx="207" cy="189" r="0.5" style="stroke:#000000"/> -<circle cx="305" cy="237" r="0.5" style="stroke:#000000"/> -<circle cx="303" cy="200" r="0.5" style="stroke:#000000"/> -<circle cx="150" cy="197" r="0.5" style="stroke:#000000"/> -<circle cx="286" cy="268" r="0.5" style="stroke:#000000"/> -<circle cx="254" cy="227" r="0.5" style="stroke:#000000"/> -<circle cx="254" cy="152" r="0.5" style="stroke:#000000"/> -<circle cx="387" cy="322" r="0.5" style="stroke:#000000"/> -<circle cx="250" cy="117" r="0.5" style="stroke:#000000"/> -<circle cx="341" cy="97" r="0.5" style="stroke:#000000"/> -<circle cx="327" cy="122" r="0.5" style="stroke:#000000"/> -<circle cx="412" cy="193" r="0.5" style="stroke:#000000"/> -<circle cx="329" cy="315" r="0.5" style="stroke:#000000"/> -<circle cx="372" cy="130" r="0.5" style="stroke:#000000"/> -<circle cx="328" cy="120" r="0.5" style="stroke:#000000"/> -<circle cx="279" cy="190" r="0.5" style="stroke:#000000"/> -<circle cx="248" cy="132" r="0.5" style="stroke:#000000"/> -<circle cx="213" cy="199" r="0.5" style="stroke:#000000"/> -<circle cx="291" cy="218" r="0.5" style="stroke:#000000"/> -<circle cx="297" cy="200" r="0.5" style="stroke:#000000"/> -<circle cx="264" cy="309" r="0.5" style="stroke:#000000"/> -<circle cx="257" cy="100" r="0.5" style="stroke:#000000"/> -<circle cx="308" cy="235" r="0.5" style="stroke:#000000"/> -<circle cx="296" cy="312" r="0.5" style="stroke:#000000"/> -<circle cx="305" cy="240" r="0.5" style="stroke:#000000"/> -<circle cx="264" cy="178" r="0.5" style="stroke:#000000"/> -<circle cx="383" cy="317" r="0.5" style="stroke:#000000"/> -<circle cx="319" cy="189" r="0.5" style="stroke:#000000"/> -<circle cx="247" cy="241" r="0.5" style="stroke:#000000"/> -<circle cx="306" cy="193" r="0.5" style="stroke:#000000"/> -<circle cx="302" cy="190" r="0.5" style="stroke:#000000"/> -<circle cx="292" cy="319" r="0.5" style="stroke:#000000"/> -<circle cx="298" cy="203" r="0.5" style="stroke:#000000"/> -<circle cx="280" cy="211" r="0.5" style="stroke:#000000"/> -<circle cx="296" cy="202" r="0.5" style="stroke:#000000"/> -<circle cx="243" cy="272" r="0.5" style="stroke:#000000"/> -<circle cx="392" cy="263" r="0.5" style="stroke:#000000"/> -<circle cx="331" cy="74" r="0.5" style="stroke:#000000"/> -<circle cx="292" cy="303" r="0.5" style="stroke:#000000"/> -<circle cx="310" cy="181" r="0.5" style="stroke:#000000"/> -<circle cx="302" cy="168" r="0.5" style="stroke:#000000"/> -<circle cx="287" cy="227" r="0.5" style="stroke:#000000"/> -<circle cx="288" cy="196" r="0.5" style="stroke:#000000"/> -<circle cx="326" cy="210" r="0.5" style="stroke:#000000"/> -<circle cx="244" cy="206" r="0.5" style="stroke:#000000"/> -<circle cx="325" cy="205" r="0.5" style="stroke:#000000"/> -<circle cx="287" cy="206" r="0.5" style="stroke:#000000"/> -<circle cx="194" cy="265" r="0.5" style="stroke:#000000"/> -<circle cx="397" cy="314" r="0.5" style="stroke:#000000"/> -<circle cx="307" cy="204" r="0.5" style="stroke:#000000"/> -<circle cx="286" cy="212" r="0.5" style="stroke:#000000"/> -<circle cx="436" cy="227" r="0.5" style="stroke:#000000"/> -<circle cx="373" cy="161" r="0.5" style="stroke:#000000"/> -<circle cx="298" cy="199" r="0.5" style="stroke:#000000"/> -<circle cx="244" cy="172" r="0.5" style="stroke:#000000"/> -<circle cx="360" cy="290" r="0.5" style="stroke:#000000"/> -<circle cx="299" cy="202" r="0.5" style="stroke:#000000"/> -<circle cx="300" cy="195" r="0.5" style="stroke:#000000"/> -<circle cx="201" cy="252" r="0.5" style="stroke:#000000"/> -<circle cx="323" cy="210" r="0.5" style="stroke:#000000"/> -<circle cx="350" cy="228" r="0.5" style="stroke:#000000"/> -<circle cx="341" cy="170" r="0.5" style="stroke:#000000"/> -<circle cx="349" cy="157" r="0.5" style="stroke:#000000"/> -<circle cx="340" cy="94" r="0.5" style="stroke:#000000"/> -<circle cx="202" cy="147" r="0.5" style="stroke:#000000"/> -<circle cx="254" cy="174" r="0.5" style="stroke:#000000"/> -<circle cx="309" cy="176" r="0.5" style="stroke:#000000"/> -<circle cx="260" cy="183" r="0.5" style="stroke:#000000"/> -<circle cx="391" cy="243" r="0.5" style="stroke:#000000"/> -<circle cx="326" cy="210" r="0.5" style="stroke:#000000"/> -<circle cx="210" cy="175" r="0.5" style="stroke:#000000"/> -<circle cx="300" cy="200" r="0.5" style="stroke:#000000"/> -<circle cx="364" cy="163" r="0.5" style="stroke:#000000"/> -<circle cx="271" cy="121" r="0.5" style="stroke:#000000"/> -<circle cx="294" cy="149" r="0.5" style="stroke:#000000"/> -<circle cx="278" cy="205" r="0.5" style="stroke:#000000"/> -<circle cx="245" cy="311" r="0.5" style="stroke:#000000"/> -<circle cx="363" cy="131" r="0.5" style="stroke:#000000"/> -<circle cx="262" cy="236" r="0.5" style="stroke:#000000"/> -<circle cx="369" cy="128" r="0.5" style="stroke:#000000"/> -<circle cx="317" cy="327" r="0.5" style="stroke:#000000"/> -<circle cx="283" cy="143" r="0.5" style="stroke:#000000"/> -<circle cx="239" cy="194" r="0.5" style="stroke:#000000"/> -<circle cx="333" cy="231" r="0.5" style="stroke:#000000"/> -<circle cx="340" cy="129" r="0.5" style="stroke:#000000"/> -<circle cx="271" cy="105" r="0.5" style="stroke:#000000"/> -<circle cx="302" cy="100" r="0.5" style="stroke:#000000"/> -<circle cx="303" cy="197" r="0.5" style="stroke:#000000"/> -<circle cx="395" cy="303" r="0.5" style="stroke:#000000"/> -<circle cx="210" cy="227" r="0.5" style="stroke:#000000"/> -<circle cx="317" cy="174" r="0.5" style="stroke:#000000"/> -<circle cx="441" cy="184" r="0.5" style="stroke:#000000"/> -<circle cx="447" cy="175" r="0.5" style="stroke:#000000"/> -<circle cx="294" cy="191" r="0.5" style="stroke:#000000"/> -<circle cx="281" cy="184" r="0.5" style="stroke:#000000"/> -<circle cx="212" cy="148" r="0.5" style="stroke:#000000"/> -<circle cx="315" cy="179" r="0.5" style="stroke:#000000"/> -<circle cx="318" cy="190" r="0.5" style="stroke:#000000"/> -<circle cx="232" cy="164" r="0.5" style="stroke:#000000"/> -<circle cx="425" cy="239" r="0.5" style="stroke:#000000"/> -<circle cx="387" cy="195" r="0.5" style="stroke:#000000"/> -<circle cx="322" cy="152" r="0.5" style="stroke:#000000"/> -<circle cx="213" cy="278" r="0.5" style="stroke:#000000"/> -<circle cx="187" cy="132" r="0.5" style="stroke:#000000"/> -<circle cx="245" cy="161" r="0.5" style="stroke:#000000"/> -<circle cx="292" cy="202" r="0.5" style="stroke:#000000"/> -<circle cx="336" cy="155" r="0.5" style="stroke:#000000"/> -<circle cx="272" cy="65" r="0.5" style="stroke:#000000"/> -<circle cx="204" cy="190" r="0.5" style="stroke:#000000"/> -<circle cx="351" cy="82" r="0.5" style="stroke:#000000"/> -<circle cx="259" cy="284" r="0.5" style="stroke:#000000"/> -<circle cx="288" cy="189" r="0.5" style="stroke:#000000"/> -<circle cx="300" cy="200" r="0.5" style="stroke:#000000"/> -<circle cx="353" cy="288" r="0.5" style="stroke:#000000"/> -<circle cx="301" cy="199" r="0.5" style="stroke:#000000"/> -<circle cx="218" cy="128" r="0.5" style="stroke:#000000"/> -<circle cx="226" cy="243" r="0.5" style="stroke:#000000"/> -<circle cx="195" cy="146" r="0.5" style="stroke:#000000"/> -<circle cx="284" cy="174" r="0.5" style="stroke:#000000"/> -<circle cx="428" cy="200" r="0.5" style="stroke:#000000"/> -<circle cx="274" cy="214" r="0.5" style="stroke:#000000"/> -<circle cx="211" cy="131" r="0.5" style="stroke:#000000"/> -<circle cx="291" cy="196" r="0.5" style="stroke:#000000"/> -<circle cx="310" cy="180" r="0.5" style="stroke:#000000"/> -<circle cx="172" cy="257" r="0.5" style="stroke:#000000"/> -<circle cx="431" cy="212" r="0.5" style="stroke:#000000"/> -<circle cx="290" cy="187" r="0.5" style="stroke:#000000"/> -<circle cx="219" cy="203" r="0.5" style="stroke:#000000"/> -<circle cx="230" cy="279" r="0.5" style="stroke:#000000"/> -<circle cx="291" cy="192" r="0.5" style="stroke:#000000"/> -<circle cx="291" cy="254" r="0.5" style="stroke:#000000"/> -<circle cx="245" cy="309" r="0.5" style="stroke:#000000"/> -<circle cx="345" cy="126" r="0.5" style="stroke:#000000"/> -<circle cx="175" cy="278" r="0.5" style="stroke:#000000"/> -<circle cx="289" cy="338" r="0.5" style="stroke:#000000"/> -<circle cx="442" cy="228" r="0.5" style="stroke:#000000"/> -<circle cx="242" cy="186" r="0.5" style="stroke:#000000"/> -<circle cx="249" cy="120" r="0.5" style="stroke:#000000"/> -<circle cx="415" cy="186" r="0.5" style="stroke:#000000"/> -<circle cx="242" cy="145" r="0.5" style="stroke:#000000"/> -<circle cx="384" cy="133" r="0.5" style="stroke:#000000"/> -<circle cx="20" cy="98" r="1" style="stroke:#ff0000"/> -<circle cx="50" cy="246" r="1" style="stroke:#ff0000"/> -<circle cx="83" cy="354" r="1" style="stroke:#ff0000"/> -<circle cx="164" cy="416" r="1" style="stroke:#ff0000"/> -<circle cx="236" cy="434" r="1" style="stroke:#ff0000"/> -<circle cx="343" cy="427" r="1" style="stroke:#ff0000"/> -<circle cx="366" cy="412" r="1" style="stroke:#ff0000"/> -<circle cx="379" cy="402" r="1" style="stroke:#ff0000"/> -<circle cx="519" cy="143" r="1" style="stroke:#ff0000"/> -<circle cx="528" cy="126" r="1" style="stroke:#ff0000"/> -<circle cx="529" cy="115" r="1" style="stroke:#ff0000"/> -<circle cx="510" cy="96" r="1" style="stroke:#ff0000"/> -<circle cx="506" cy="95" r="1" style="stroke:#ff0000"/> -<circle cx="117" cy="33" r="1" style="stroke:#ff0000"/> -<circle cx="85" cy="28" r="1" style="stroke:#ff0000"/> -<circle cx="40" cy="64" r="1" style="stroke:#ff0000"/> -</svg> diff --git a/testsuite/tests/dph/quickhull/dph-quickhull-vseg-opt.stdout b/testsuite/tests/dph/quickhull/dph-quickhull-vseg-opt.stdout deleted file mode 100644 index f6b2d92e9a..0000000000 --- a/testsuite/tests/dph/quickhull/dph-quickhull-vseg-opt.stdout +++ /dev/null @@ -1,1019 +0,0 @@ -<svg width="100%" height="100%" version="1.1" xmlns="http://www.w3.org/2000/svg"> -<polygon points="20,98 50,246 83,354 164,416 236,434 343,427 366,412 379,402 519,143 528,126 529,115 510,96 506,95 117,33 85,28 40,64 " style="fill:#d0d0ff;stroke:#000000;stroke-width:1"/> -<circle cx="217" cy="201" r="0.5" style="stroke:#000000"/> -<circle cx="310" cy="266" r="0.5" style="stroke:#000000"/> -<circle cx="191" cy="353" r="0.5" style="stroke:#000000"/> -<circle cx="164" cy="416" r="0.5" style="stroke:#000000"/> -<circle cx="232" cy="257" r="0.5" style="stroke:#000000"/> -<circle cx="266" cy="398" r="0.5" style="stroke:#000000"/> -<circle cx="350" cy="201" r="0.5" style="stroke:#000000"/> -<circle cx="334" cy="202" r="0.5" style="stroke:#000000"/> -<circle cx="189" cy="151" r="0.5" style="stroke:#000000"/> -<circle cx="308" cy="307" r="0.5" style="stroke:#000000"/> -<circle cx="347" cy="160" r="0.5" style="stroke:#000000"/> -<circle cx="251" cy="251" r="0.5" style="stroke:#000000"/> -<circle cx="275" cy="241" r="0.5" style="stroke:#000000"/> -<circle cx="275" cy="398" r="0.5" style="stroke:#000000"/> -<circle cx="167" cy="292" r="0.5" style="stroke:#000000"/> -<circle cx="351" cy="397" r="0.5" style="stroke:#000000"/> -<circle cx="257" cy="254" r="0.5" style="stroke:#000000"/> -<circle cx="248" cy="220" r="0.5" style="stroke:#000000"/> -<circle cx="250" cy="252" r="0.5" style="stroke:#000000"/> -<circle cx="191" cy="222" r="0.5" style="stroke:#000000"/> -<circle cx="93" cy="200" r="0.5" style="stroke:#000000"/> -<circle cx="155" cy="195" r="0.5" style="stroke:#000000"/> -<circle cx="287" cy="84" r="0.5" style="stroke:#000000"/> -<circle cx="90" cy="198" r="0.5" style="stroke:#000000"/> -<circle cx="149" cy="175" r="0.5" style="stroke:#000000"/> -<circle cx="342" cy="311" r="0.5" style="stroke:#000000"/> -<circle cx="391" cy="360" r="0.5" style="stroke:#000000"/> -<circle cx="277" cy="310" r="0.5" style="stroke:#000000"/> -<circle cx="341" cy="421" r="0.5" style="stroke:#000000"/> -<circle cx="274" cy="136" r="0.5" style="stroke:#000000"/> -<circle cx="187" cy="278" r="0.5" style="stroke:#000000"/> -<circle cx="343" cy="427" r="0.5" style="stroke:#000000"/> -<circle cx="255" cy="170" r="0.5" style="stroke:#000000"/> -<circle cx="158" cy="329" r="0.5" style="stroke:#000000"/> -<circle cx="306" cy="196" r="0.5" style="stroke:#000000"/> -<circle cx="315" cy="261" r="0.5" style="stroke:#000000"/> -<circle cx="214" cy="361" r="0.5" style="stroke:#000000"/> -<circle cx="306" cy="304" r="0.5" style="stroke:#000000"/> -<circle cx="229" cy="219" r="0.5" style="stroke:#000000"/> -<circle cx="227" cy="351" r="0.5" style="stroke:#000000"/> -<circle cx="228" cy="196" r="0.5" style="stroke:#000000"/> -<circle cx="314" cy="280" r="0.5" style="stroke:#000000"/> -<circle cx="209" cy="195" r="0.5" style="stroke:#000000"/> -<circle cx="367" cy="217" r="0.5" style="stroke:#000000"/> -<circle cx="176" cy="212" r="0.5" style="stroke:#000000"/> -<circle cx="117" cy="194" r="0.5" style="stroke:#000000"/> -<circle cx="318" cy="116" r="0.5" style="stroke:#000000"/> -<circle cx="250" cy="251" r="0.5" style="stroke:#000000"/> -<circle cx="355" cy="406" r="0.5" style="stroke:#000000"/> -<circle cx="252" cy="246" r="0.5" style="stroke:#000000"/> -<circle cx="219" cy="299" r="0.5" style="stroke:#000000"/> -<circle cx="217" cy="232" r="0.5" style="stroke:#000000"/> -<circle cx="283" cy="220" r="0.5" style="stroke:#000000"/> -<circle cx="239" cy="207" r="0.5" style="stroke:#000000"/> -<circle cx="266" cy="255" r="0.5" style="stroke:#000000"/> -<circle cx="310" cy="324" r="0.5" style="stroke:#000000"/> -<circle cx="200" cy="248" r="0.5" style="stroke:#000000"/> -<circle cx="387" cy="360" r="0.5" style="stroke:#000000"/> -<circle cx="147" cy="186" r="0.5" style="stroke:#000000"/> -<circle cx="126" cy="236" r="0.5" style="stroke:#000000"/> -<circle cx="257" cy="300" r="0.5" style="stroke:#000000"/> -<circle cx="255" cy="250" r="0.5" style="stroke:#000000"/> -<circle cx="50" cy="246" r="0.5" style="stroke:#000000"/> -<circle cx="231" cy="340" r="0.5" style="stroke:#000000"/> -<circle cx="189" cy="287" r="0.5" style="stroke:#000000"/> -<circle cx="188" cy="186" r="0.5" style="stroke:#000000"/> -<circle cx="366" cy="412" r="0.5" style="stroke:#000000"/> -<circle cx="183" cy="139" r="0.5" style="stroke:#000000"/> -<circle cx="305" cy="113" r="0.5" style="stroke:#000000"/> -<circle cx="286" cy="146" r="0.5" style="stroke:#000000"/> -<circle cx="399" cy="241" r="0.5" style="stroke:#000000"/> -<circle cx="289" cy="404" r="0.5" style="stroke:#000000"/> -<circle cx="346" cy="157" r="0.5" style="stroke:#000000"/> -<circle cx="287" cy="143" r="0.5" style="stroke:#000000"/> -<circle cx="223" cy="236" r="0.5" style="stroke:#000000"/> -<circle cx="181" cy="159" r="0.5" style="stroke:#000000"/> -<circle cx="134" cy="249" r="0.5" style="stroke:#000000"/> -<circle cx="238" cy="274" r="0.5" style="stroke:#000000"/> -<circle cx="246" cy="250" r="0.5" style="stroke:#000000"/> -<circle cx="201" cy="395" r="0.5" style="stroke:#000000"/> -<circle cx="192" cy="116" r="0.5" style="stroke:#000000"/> -<circle cx="260" cy="296" r="0.5" style="stroke:#000000"/> -<circle cx="244" cy="399" r="0.5" style="stroke:#000000"/> -<circle cx="256" cy="303" r="0.5" style="stroke:#000000"/> -<circle cx="202" cy="221" r="0.5" style="stroke:#000000"/> -<circle cx="361" cy="406" r="0.5" style="stroke:#000000"/> -<circle cx="275" cy="235" r="0.5" style="stroke:#000000"/> -<circle cx="180" cy="305" r="0.5" style="stroke:#000000"/> -<circle cx="258" cy="241" r="0.5" style="stroke:#000000"/> -<circle cx="253" cy="237" r="0.5" style="stroke:#000000"/> -<circle cx="239" cy="408" r="0.5" style="stroke:#000000"/> -<circle cx="247" cy="254" r="0.5" style="stroke:#000000"/> -<circle cx="223" cy="265" r="0.5" style="stroke:#000000"/> -<circle cx="244" cy="253" r="0.5" style="stroke:#000000"/> -<circle cx="174" cy="346" r="0.5" style="stroke:#000000"/> -<circle cx="373" cy="334" r="0.5" style="stroke:#000000"/> -<circle cx="292" cy="82" r="0.5" style="stroke:#000000"/> -<circle cx="240" cy="388" r="0.5" style="stroke:#000000"/> -<circle cx="263" cy="225" r="0.5" style="stroke:#000000"/> -<circle cx="252" cy="207" r="0.5" style="stroke:#000000"/> -<circle cx="233" cy="287" r="0.5" style="stroke:#000000"/> -<circle cx="234" cy="245" r="0.5" style="stroke:#000000"/> -<circle cx="285" cy="264" r="0.5" style="stroke:#000000"/> -<circle cx="176" cy="259" r="0.5" style="stroke:#000000"/> -<circle cx="284" cy="256" r="0.5" style="stroke:#000000"/> -<circle cx="233" cy="258" r="0.5" style="stroke:#000000"/> -<circle cx="108" cy="336" r="0.5" style="stroke:#000000"/> -<circle cx="379" cy="402" r="0.5" style="stroke:#000000"/> -<circle cx="260" cy="256" r="0.5" style="stroke:#000000"/> -<circle cx="232" cy="265" r="0.5" style="stroke:#000000"/> -<circle cx="432" cy="286" r="0.5" style="stroke:#000000"/> -<circle cx="347" cy="197" r="0.5" style="stroke:#000000"/> -<circle cx="248" cy="249" r="0.5" style="stroke:#000000"/> -<circle cx="176" cy="213" r="0.5" style="stroke:#000000"/> -<circle cx="330" cy="370" r="0.5" style="stroke:#000000"/> -<circle cx="249" cy="253" r="0.5" style="stroke:#000000"/> -<circle cx="249" cy="243" r="0.5" style="stroke:#000000"/> -<circle cx="119" cy="320" r="0.5" style="stroke:#000000"/> -<circle cx="280" cy="263" r="0.5" style="stroke:#000000"/> -<circle cx="317" cy="287" r="0.5" style="stroke:#000000"/> -<circle cx="304" cy="209" r="0.5" style="stroke:#000000"/> -<circle cx="315" cy="193" r="0.5" style="stroke:#000000"/> -<circle cx="304" cy="109" r="0.5" style="stroke:#000000"/> -<circle cx="119" cy="179" r="0.5" style="stroke:#000000"/> -<circle cx="188" cy="215" r="0.5" style="stroke:#000000"/> -<circle cx="263" cy="218" r="0.5" style="stroke:#000000"/> -<circle cx="196" cy="228" r="0.5" style="stroke:#000000"/> -<circle cx="371" cy="307" r="0.5" style="stroke:#000000"/> -<circle cx="285" cy="263" r="0.5" style="stroke:#000000"/> -<circle cx="130" cy="217" r="0.5" style="stroke:#000000"/> -<circle cx="250" cy="250" r="0.5" style="stroke:#000000"/> -<circle cx="335" cy="201" r="0.5" style="stroke:#000000"/> -<circle cx="211" cy="145" r="0.5" style="stroke:#000000"/> -<circle cx="242" cy="182" r="0.5" style="stroke:#000000"/> -<circle cx="221" cy="256" r="0.5" style="stroke:#000000"/> -<circle cx="177" cy="398" r="0.5" style="stroke:#000000"/> -<circle cx="333" cy="158" r="0.5" style="stroke:#000000"/> -<circle cx="199" cy="297" r="0.5" style="stroke:#000000"/> -<circle cx="342" cy="153" r="0.5" style="stroke:#000000"/> -<circle cx="273" cy="419" r="0.5" style="stroke:#000000"/> -<circle cx="227" cy="173" r="0.5" style="stroke:#000000"/> -<circle cx="169" cy="242" r="0.5" style="stroke:#000000"/> -<circle cx="294" cy="292" r="0.5" style="stroke:#000000"/> -<circle cx="303" cy="155" r="0.5" style="stroke:#000000"/> -<circle cx="211" cy="124" r="0.5" style="stroke:#000000"/> -<circle cx="253" cy="116" r="0.5" style="stroke:#000000"/> -<circle cx="254" cy="246" r="0.5" style="stroke:#000000"/> -<circle cx="377" cy="388" r="0.5" style="stroke:#000000"/> -<circle cx="130" cy="285" r="0.5" style="stroke:#000000"/> -<circle cx="273" cy="215" r="0.5" style="stroke:#000000"/> -<circle cx="438" cy="229" r="0.5" style="stroke:#000000"/> -<circle cx="446" cy="216" r="0.5" style="stroke:#000000"/> -<circle cx="242" cy="238" r="0.5" style="stroke:#000000"/> -<circle cx="224" cy="229" r="0.5" style="stroke:#000000"/> -<circle cx="133" cy="181" r="0.5" style="stroke:#000000"/> -<circle cx="270" cy="222" r="0.5" style="stroke:#000000"/> -<circle cx="275" cy="237" r="0.5" style="stroke:#000000"/> -<circle cx="160" cy="202" r="0.5" style="stroke:#000000"/> -<circle cx="416" cy="302" r="0.5" style="stroke:#000000"/> -<circle cx="366" cy="244" r="0.5" style="stroke:#000000"/> -<circle cx="279" cy="186" r="0.5" style="stroke:#000000"/> -<circle cx="134" cy="353" r="0.5" style="stroke:#000000"/> -<circle cx="99" cy="159" r="0.5" style="stroke:#000000"/> -<circle cx="177" cy="198" r="0.5" style="stroke:#000000"/> -<circle cx="239" cy="253" r="0.5" style="stroke:#000000"/> -<circle cx="298" cy="190" r="0.5" style="stroke:#000000"/> -<circle cx="213" cy="70" r="0.5" style="stroke:#000000"/> -<circle cx="122" cy="236" r="0.5" style="stroke:#000000"/> -<circle cx="318" cy="92" r="0.5" style="stroke:#000000"/> -<circle cx="196" cy="362" r="0.5" style="stroke:#000000"/> -<circle cx="234" cy="235" r="0.5" style="stroke:#000000"/> -<circle cx="250" cy="250" r="0.5" style="stroke:#000000"/> -<circle cx="321" cy="367" r="0.5" style="stroke:#000000"/> -<circle cx="251" cy="249" r="0.5" style="stroke:#000000"/> -<circle cx="141" cy="154" r="0.5" style="stroke:#000000"/> -<circle cx="152" cy="308" r="0.5" style="stroke:#000000"/> -<circle cx="110" cy="178" r="0.5" style="stroke:#000000"/> -<circle cx="229" cy="216" r="0.5" style="stroke:#000000"/> -<circle cx="421" cy="250" r="0.5" style="stroke:#000000"/> -<circle cx="215" cy="269" r="0.5" style="stroke:#000000"/> -<circle cx="131" cy="157" r="0.5" style="stroke:#000000"/> -<circle cx="238" cy="245" r="0.5" style="stroke:#000000"/> -<circle cx="264" cy="224" r="0.5" style="stroke:#000000"/> -<circle cx="79" cy="327" r="0.5" style="stroke:#000000"/> -<circle cx="424" cy="266" r="0.5" style="stroke:#000000"/> -<circle cx="237" cy="232" r="0.5" style="stroke:#000000"/> -<circle cx="142" cy="253" r="0.5" style="stroke:#000000"/> -<circle cx="156" cy="355" r="0.5" style="stroke:#000000"/> -<circle cx="239" cy="239" r="0.5" style="stroke:#000000"/> -<circle cx="238" cy="322" r="0.5" style="stroke:#000000"/> -<circle cx="177" cy="396" r="0.5" style="stroke:#000000"/> -<circle cx="310" cy="152" r="0.5" style="stroke:#000000"/> -<circle cx="83" cy="354" r="0.5" style="stroke:#000000"/> -<circle cx="236" cy="434" r="0.5" style="stroke:#000000"/> -<circle cx="439" cy="287" r="0.5" style="stroke:#000000"/> -<circle cx="173" cy="232" r="0.5" style="stroke:#000000"/> -<circle cx="181" cy="143" r="0.5" style="stroke:#000000"/> -<circle cx="404" cy="232" r="0.5" style="stroke:#000000"/> -<circle cx="173" cy="177" r="0.5" style="stroke:#000000"/> -<circle cx="362" cy="161" r="0.5" style="stroke:#000000"/> -<circle cx="87" cy="81" r="0.5" style="stroke:#000000"/> -<circle cx="124" cy="106" r="0.5" style="stroke:#000000"/> -<circle cx="76" cy="141" r="0.5" style="stroke:#000000"/> -<circle cx="65" cy="166" r="0.5" style="stroke:#000000"/> -<circle cx="93" cy="103" r="0.5" style="stroke:#000000"/> -<circle cx="107" cy="159" r="0.5" style="stroke:#000000"/> -<circle cx="140" cy="80" r="0.5" style="stroke:#000000"/> -<circle cx="134" cy="81" r="0.5" style="stroke:#000000"/> -<circle cx="76" cy="60" r="0.5" style="stroke:#000000"/> -<circle cx="123" cy="123" r="0.5" style="stroke:#000000"/> -<circle cx="139" cy="64" r="0.5" style="stroke:#000000"/> -<circle cx="100" cy="100" r="0.5" style="stroke:#000000"/> -<circle cx="110" cy="96" r="0.5" style="stroke:#000000"/> -<circle cx="110" cy="159" r="0.5" style="stroke:#000000"/> -<circle cx="67" cy="117" r="0.5" style="stroke:#000000"/> -<circle cx="140" cy="159" r="0.5" style="stroke:#000000"/> -<circle cx="103" cy="101" r="0.5" style="stroke:#000000"/> -<circle cx="99" cy="88" r="0.5" style="stroke:#000000"/> -<circle cx="100" cy="101" r="0.5" style="stroke:#000000"/> -<circle cx="76" cy="89" r="0.5" style="stroke:#000000"/> -<circle cx="37" cy="80" r="0.5" style="stroke:#000000"/> -<circle cx="62" cy="78" r="0.5" style="stroke:#000000"/> -<circle cx="115" cy="34" r="0.5" style="stroke:#000000"/> -<circle cx="36" cy="79" r="0.5" style="stroke:#000000"/> -<circle cx="60" cy="70" r="0.5" style="stroke:#000000"/> -<circle cx="137" cy="124" r="0.5" style="stroke:#000000"/> -<circle cx="156" cy="144" r="0.5" style="stroke:#000000"/> -<circle cx="111" cy="124" r="0.5" style="stroke:#000000"/> -<circle cx="137" cy="168" r="0.5" style="stroke:#000000"/> -<circle cx="110" cy="55" r="0.5" style="stroke:#000000"/> -<circle cx="75" cy="111" r="0.5" style="stroke:#000000"/> -<circle cx="137" cy="171" r="0.5" style="stroke:#000000"/> -<circle cx="102" cy="68" r="0.5" style="stroke:#000000"/> -<circle cx="63" cy="131" r="0.5" style="stroke:#000000"/> -<circle cx="122" cy="78" r="0.5" style="stroke:#000000"/> -<circle cx="126" cy="104" r="0.5" style="stroke:#000000"/> -<circle cx="86" cy="144" r="0.5" style="stroke:#000000"/> -<circle cx="123" cy="122" r="0.5" style="stroke:#000000"/> -<circle cx="92" cy="88" r="0.5" style="stroke:#000000"/> -<circle cx="91" cy="140" r="0.5" style="stroke:#000000"/> -<circle cx="91" cy="78" r="0.5" style="stroke:#000000"/> -<circle cx="126" cy="112" r="0.5" style="stroke:#000000"/> -<circle cx="84" cy="78" r="0.5" style="stroke:#000000"/> -<circle cx="147" cy="87" r="0.5" style="stroke:#000000"/> -<circle cx="70" cy="85" r="0.5" style="stroke:#000000"/> -<circle cx="47" cy="77" r="0.5" style="stroke:#000000"/> -<circle cx="127" cy="46" r="0.5" style="stroke:#000000"/> -<circle cx="100" cy="100" r="0.5" style="stroke:#000000"/> -<circle cx="142" cy="163" r="0.5" style="stroke:#000000"/> -<circle cx="101" cy="99" r="0.5" style="stroke:#000000"/> -<circle cx="88" cy="119" r="0.5" style="stroke:#000000"/> -<circle cx="87" cy="93" r="0.5" style="stroke:#000000"/> -<circle cx="113" cy="88" r="0.5" style="stroke:#000000"/> -<circle cx="96" cy="83" r="0.5" style="stroke:#000000"/> -<circle cx="106" cy="102" r="0.5" style="stroke:#000000"/> -<circle cx="124" cy="130" r="0.5" style="stroke:#000000"/> -<circle cx="80" cy="99" r="0.5" style="stroke:#000000"/> -<circle cx="155" cy="144" r="0.5" style="stroke:#000000"/> -<circle cx="59" cy="74" r="0.5" style="stroke:#000000"/> -<circle cx="50" cy="94" r="0.5" style="stroke:#000000"/> -<circle cx="103" cy="120" r="0.5" style="stroke:#000000"/> -<circle cx="102" cy="100" r="0.5" style="stroke:#000000"/> -<circle cx="20" cy="98" r="0.5" style="stroke:#000000"/> -<circle cx="92" cy="136" r="0.5" style="stroke:#000000"/> -<circle cx="75" cy="115" r="0.5" style="stroke:#000000"/> -<circle cx="75" cy="74" r="0.5" style="stroke:#000000"/> -<circle cx="146" cy="165" r="0.5" style="stroke:#000000"/> -<circle cx="73" cy="56" r="0.5" style="stroke:#000000"/> -<circle cx="122" cy="45" r="0.5" style="stroke:#000000"/> -<circle cx="115" cy="59" r="0.5" style="stroke:#000000"/> -<circle cx="160" cy="97" r="0.5" style="stroke:#000000"/> -<circle cx="116" cy="161" r="0.5" style="stroke:#000000"/> -<circle cx="139" cy="63" r="0.5" style="stroke:#000000"/> -<circle cx="115" cy="57" r="0.5" style="stroke:#000000"/> -<circle cx="89" cy="94" r="0.5" style="stroke:#000000"/> -<circle cx="72" cy="64" r="0.5" style="stroke:#000000"/> -<circle cx="53" cy="99" r="0.5" style="stroke:#000000"/> -<circle cx="95" cy="110" r="0.5" style="stroke:#000000"/> -<circle cx="99" cy="100" r="0.5" style="stroke:#000000"/> -<circle cx="81" cy="158" r="0.5" style="stroke:#000000"/> -<circle cx="77" cy="46" r="0.5" style="stroke:#000000"/> -<circle cx="104" cy="118" r="0.5" style="stroke:#000000"/> -<circle cx="98" cy="160" r="0.5" style="stroke:#000000"/> -<circle cx="102" cy="121" r="0.5" style="stroke:#000000"/> -<circle cx="81" cy="88" r="0.5" style="stroke:#000000"/> -<circle cx="145" cy="163" r="0.5" style="stroke:#000000"/> -<circle cx="110" cy="94" r="0.5" style="stroke:#000000"/> -<circle cx="72" cy="122" r="0.5" style="stroke:#000000"/> -<circle cx="103" cy="96" r="0.5" style="stroke:#000000"/> -<circle cx="101" cy="95" r="0.5" style="stroke:#000000"/> -<circle cx="95" cy="163" r="0.5" style="stroke:#000000"/> -<circle cx="99" cy="101" r="0.5" style="stroke:#000000"/> -<circle cx="89" cy="106" r="0.5" style="stroke:#000000"/> -<circle cx="98" cy="101" r="0.5" style="stroke:#000000"/> -<circle cx="70" cy="138" r="0.5" style="stroke:#000000"/> -<circle cx="149" cy="134" r="0.5" style="stroke:#000000"/> -<circle cx="117" cy="33" r="0.5" style="stroke:#000000"/> -<circle cx="96" cy="155" r="0.5" style="stroke:#000000"/> -<circle cx="105" cy="90" r="0.5" style="stroke:#000000"/> -<circle cx="101" cy="83" r="0.5" style="stroke:#000000"/> -<circle cx="93" cy="115" r="0.5" style="stroke:#000000"/> -<circle cx="94" cy="98" r="0.5" style="stroke:#000000"/> -<circle cx="114" cy="105" r="0.5" style="stroke:#000000"/> -<circle cx="70" cy="103" r="0.5" style="stroke:#000000"/> -<circle cx="114" cy="103" r="0.5" style="stroke:#000000"/> -<circle cx="93" cy="103" r="0.5" style="stroke:#000000"/> -<circle cx="43" cy="135" r="0.5" style="stroke:#000000"/> -<circle cx="152" cy="161" r="0.5" style="stroke:#000000"/> -<circle cx="104" cy="102" r="0.5" style="stroke:#000000"/> -<circle cx="93" cy="106" r="0.5" style="stroke:#000000"/> -<circle cx="173" cy="115" r="0.5" style="stroke:#000000"/> -<circle cx="139" cy="79" r="0.5" style="stroke:#000000"/> -<circle cx="99" cy="99" r="0.5" style="stroke:#000000"/> -<circle cx="70" cy="85" r="0.5" style="stroke:#000000"/> -<circle cx="132" cy="148" r="0.5" style="stroke:#000000"/> -<circle cx="99" cy="101" r="0.5" style="stroke:#000000"/> -<circle cx="100" cy="97" r="0.5" style="stroke:#000000"/> -<circle cx="47" cy="128" r="0.5" style="stroke:#000000"/> -<circle cx="112" cy="105" r="0.5" style="stroke:#000000"/> -<circle cx="127" cy="115" r="0.5" style="stroke:#000000"/> -<circle cx="122" cy="84" r="0.5" style="stroke:#000000"/> -<circle cx="126" cy="77" r="0.5" style="stroke:#000000"/> -<circle cx="121" cy="44" r="0.5" style="stroke:#000000"/> -<circle cx="48" cy="72" r="0.5" style="stroke:#000000"/> -<circle cx="75" cy="86" r="0.5" style="stroke:#000000"/> -<circle cx="105" cy="87" r="0.5" style="stroke:#000000"/> -<circle cx="79" cy="91" r="0.5" style="stroke:#000000"/> -<circle cx="148" cy="123" r="0.5" style="stroke:#000000"/> -<circle cx="114" cy="105" r="0.5" style="stroke:#000000"/> -<circle cx="52" cy="87" r="0.5" style="stroke:#000000"/> -<circle cx="100" cy="100" r="0.5" style="stroke:#000000"/> -<circle cx="134" cy="80" r="0.5" style="stroke:#000000"/> -<circle cx="84" cy="58" r="0.5" style="stroke:#000000"/> -<circle cx="97" cy="73" r="0.5" style="stroke:#000000"/> -<circle cx="88" cy="102" r="0.5" style="stroke:#000000"/> -<circle cx="71" cy="159" r="0.5" style="stroke:#000000"/> -<circle cx="133" cy="63" r="0.5" style="stroke:#000000"/> -<circle cx="80" cy="119" r="0.5" style="stroke:#000000"/> -<circle cx="137" cy="61" r="0.5" style="stroke:#000000"/> -<circle cx="109" cy="168" r="0.5" style="stroke:#000000"/> -<circle cx="91" cy="69" r="0.5" style="stroke:#000000"/> -<circle cx="68" cy="97" r="0.5" style="stroke:#000000"/> -<circle cx="117" cy="117" r="0.5" style="stroke:#000000"/> -<circle cx="121" cy="62" r="0.5" style="stroke:#000000"/> -<circle cx="84" cy="50" r="0.5" style="stroke:#000000"/> -<circle cx="101" cy="46" r="0.5" style="stroke:#000000"/> -<circle cx="102" cy="98" r="0.5" style="stroke:#000000"/> -<circle cx="151" cy="155" r="0.5" style="stroke:#000000"/> -<circle cx="52" cy="114" r="0.5" style="stroke:#000000"/> -<circle cx="109" cy="86" r="0.5" style="stroke:#000000"/> -<circle cx="175" cy="91" r="0.5" style="stroke:#000000"/> -<circle cx="178" cy="87" r="0.5" style="stroke:#000000"/> -<circle cx="97" cy="95" r="0.5" style="stroke:#000000"/> -<circle cx="90" cy="92" r="0.5" style="stroke:#000000"/> -<circle cx="53" cy="72" r="0.5" style="stroke:#000000"/> -<circle cx="108" cy="89" r="0.5" style="stroke:#000000"/> -<circle cx="110" cy="95" r="0.5" style="stroke:#000000"/> -<circle cx="64" cy="81" r="0.5" style="stroke:#000000"/> -<circle cx="166" cy="121" r="0.5" style="stroke:#000000"/> -<circle cx="146" cy="97" r="0.5" style="stroke:#000000"/> -<circle cx="112" cy="74" r="0.5" style="stroke:#000000"/> -<circle cx="54" cy="141" r="0.5" style="stroke:#000000"/> -<circle cx="40" cy="64" r="0.5" style="stroke:#000000"/> -<circle cx="71" cy="79" r="0.5" style="stroke:#000000"/> -<circle cx="96" cy="101" r="0.5" style="stroke:#000000"/> -<circle cx="119" cy="76" r="0.5" style="stroke:#000000"/> -<circle cx="85" cy="28" r="0.5" style="stroke:#000000"/> -<circle cx="49" cy="94" r="0.5" style="stroke:#000000"/> -<circle cx="127" cy="37" r="0.5" style="stroke:#000000"/> -<circle cx="78" cy="145" r="0.5" style="stroke:#000000"/> -<circle cx="94" cy="94" r="0.5" style="stroke:#000000"/> -<circle cx="100" cy="100" r="0.5" style="stroke:#000000"/> -<circle cx="128" cy="147" r="0.5" style="stroke:#000000"/> -<circle cx="101" cy="100" r="0.5" style="stroke:#000000"/> -<circle cx="56" cy="62" r="0.5" style="stroke:#000000"/> -<circle cx="61" cy="123" r="0.5" style="stroke:#000000"/> -<circle cx="44" cy="71" r="0.5" style="stroke:#000000"/> -<circle cx="92" cy="86" r="0.5" style="stroke:#000000"/> -<circle cx="169" cy="100" r="0.5" style="stroke:#000000"/> -<circle cx="86" cy="107" r="0.5" style="stroke:#000000"/> -<circle cx="52" cy="63" r="0.5" style="stroke:#000000"/> -<circle cx="95" cy="98" r="0.5" style="stroke:#000000"/> -<circle cx="106" cy="89" r="0.5" style="stroke:#000000"/> -<circle cx="32" cy="131" r="0.5" style="stroke:#000000"/> -<circle cx="170" cy="106" r="0.5" style="stroke:#000000"/> -<circle cx="95" cy="93" r="0.5" style="stroke:#000000"/> -<circle cx="57" cy="101" r="0.5" style="stroke:#000000"/> -<circle cx="62" cy="142" r="0.5" style="stroke:#000000"/> -<circle cx="95" cy="95" r="0.5" style="stroke:#000000"/> -<circle cx="95" cy="129" r="0.5" style="stroke:#000000"/> -<circle cx="71" cy="158" r="0.5" style="stroke:#000000"/> -<circle cx="124" cy="61" r="0.5" style="stroke:#000000"/> -<circle cx="33" cy="142" r="0.5" style="stroke:#000000"/> -<circle cx="94" cy="174" r="0.5" style="stroke:#000000"/> -<circle cx="176" cy="115" r="0.5" style="stroke:#000000"/> -<circle cx="69" cy="93" r="0.5" style="stroke:#000000"/> -<circle cx="73" cy="57" r="0.5" style="stroke:#000000"/> -<circle cx="162" cy="93" r="0.5" style="stroke:#000000"/> -<circle cx="69" cy="71" r="0.5" style="stroke:#000000"/> -<circle cx="145" cy="64" r="0.5" style="stroke:#000000"/> -<circle cx="145" cy="293" r="0.5" style="stroke:#000000"/> -<circle cx="159" cy="302" r="0.5" style="stroke:#000000"/> -<circle cx="141" cy="315" r="0.5" style="stroke:#000000"/> -<circle cx="137" cy="325" r="0.5" style="stroke:#000000"/> -<circle cx="147" cy="301" r="0.5" style="stroke:#000000"/> -<circle cx="152" cy="322" r="0.5" style="stroke:#000000"/> -<circle cx="165" cy="293" r="0.5" style="stroke:#000000"/> -<circle cx="163" cy="293" r="0.5" style="stroke:#000000"/> -<circle cx="141" cy="285" r="0.5" style="stroke:#000000"/> -<circle cx="159" cy="309" r="0.5" style="stroke:#000000"/> -<circle cx="164" cy="287" r="0.5" style="stroke:#000000"/> -<circle cx="150" cy="300" r="0.5" style="stroke:#000000"/> -<circle cx="154" cy="299" r="0.5" style="stroke:#000000"/> -<circle cx="154" cy="322" r="0.5" style="stroke:#000000"/> -<circle cx="138" cy="306" r="0.5" style="stroke:#000000"/> -<circle cx="165" cy="322" r="0.5" style="stroke:#000000"/> -<circle cx="151" cy="301" r="0.5" style="stroke:#000000"/> -<circle cx="150" cy="295" r="0.5" style="stroke:#000000"/> -<circle cx="150" cy="300" r="0.5" style="stroke:#000000"/> -<circle cx="141" cy="296" r="0.5" style="stroke:#000000"/> -<circle cx="126" cy="292" r="0.5" style="stroke:#000000"/> -<circle cx="136" cy="292" r="0.5" style="stroke:#000000"/> -<circle cx="156" cy="275" r="0.5" style="stroke:#000000"/> -<circle cx="126" cy="292" r="0.5" style="stroke:#000000"/> -<circle cx="135" cy="289" r="0.5" style="stroke:#000000"/> -<circle cx="164" cy="309" r="0.5" style="stroke:#000000"/> -<circle cx="171" cy="316" r="0.5" style="stroke:#000000"/> -<circle cx="154" cy="309" r="0.5" style="stroke:#000000"/> -<circle cx="164" cy="326" r="0.5" style="stroke:#000000"/> -<circle cx="154" cy="283" r="0.5" style="stroke:#000000"/> -<circle cx="141" cy="304" r="0.5" style="stroke:#000000"/> -<circle cx="164" cy="326" r="0.5" style="stroke:#000000"/> -<circle cx="151" cy="288" r="0.5" style="stroke:#000000"/> -<circle cx="136" cy="312" r="0.5" style="stroke:#000000"/> -<circle cx="158" cy="292" r="0.5" style="stroke:#000000"/> -<circle cx="160" cy="302" r="0.5" style="stroke:#000000"/> -<circle cx="145" cy="317" r="0.5" style="stroke:#000000"/> -<circle cx="158" cy="308" r="0.5" style="stroke:#000000"/> -<circle cx="147" cy="295" r="0.5" style="stroke:#000000"/> -<circle cx="147" cy="315" r="0.5" style="stroke:#000000"/> -<circle cx="147" cy="292" r="0.5" style="stroke:#000000"/> -<circle cx="160" cy="304" r="0.5" style="stroke:#000000"/> -<circle cx="144" cy="292" r="0.5" style="stroke:#000000"/> -<circle cx="168" cy="295" r="0.5" style="stroke:#000000"/> -<circle cx="139" cy="294" r="0.5" style="stroke:#000000"/> -<circle cx="130" cy="292" r="0.5" style="stroke:#000000"/> -<circle cx="160" cy="280" r="0.5" style="stroke:#000000"/> -<circle cx="150" cy="300" r="0.5" style="stroke:#000000"/> -<circle cx="166" cy="323" r="0.5" style="stroke:#000000"/> -<circle cx="150" cy="299" r="0.5" style="stroke:#000000"/> -<circle cx="145" cy="307" r="0.5" style="stroke:#000000"/> -<circle cx="145" cy="297" r="0.5" style="stroke:#000000"/> -<circle cx="155" cy="296" r="0.5" style="stroke:#000000"/> -<circle cx="148" cy="294" r="0.5" style="stroke:#000000"/> -<circle cx="152" cy="301" r="0.5" style="stroke:#000000"/> -<circle cx="159" cy="311" r="0.5" style="stroke:#000000"/> -<circle cx="142" cy="300" r="0.5" style="stroke:#000000"/> -<circle cx="171" cy="317" r="0.5" style="stroke:#000000"/> -<circle cx="135" cy="290" r="0.5" style="stroke:#000000"/> -<circle cx="131" cy="298" r="0.5" style="stroke:#000000"/> -<circle cx="151" cy="307" r="0.5" style="stroke:#000000"/> -<circle cx="151" cy="300" r="0.5" style="stroke:#000000"/> -<circle cx="120" cy="299" r="0.5" style="stroke:#000000"/> -<circle cx="147" cy="314" r="0.5" style="stroke:#000000"/> -<circle cx="141" cy="305" r="0.5" style="stroke:#000000"/> -<circle cx="141" cy="290" r="0.5" style="stroke:#000000"/> -<circle cx="167" cy="324" r="0.5" style="stroke:#000000"/> -<circle cx="140" cy="283" r="0.5" style="stroke:#000000"/> -<circle cx="158" cy="279" r="0.5" style="stroke:#000000"/> -<circle cx="155" cy="284" r="0.5" style="stroke:#000000"/> -<circle cx="172" cy="299" r="0.5" style="stroke:#000000"/> -<circle cx="156" cy="323" r="0.5" style="stroke:#000000"/> -<circle cx="164" cy="286" r="0.5" style="stroke:#000000"/> -<circle cx="156" cy="284" r="0.5" style="stroke:#000000"/> -<circle cx="146" cy="298" r="0.5" style="stroke:#000000"/> -<circle cx="140" cy="286" r="0.5" style="stroke:#000000"/> -<circle cx="133" cy="300" r="0.5" style="stroke:#000000"/> -<circle cx="148" cy="304" r="0.5" style="stroke:#000000"/> -<circle cx="149" cy="300" r="0.5" style="stroke:#000000"/> -<circle cx="143" cy="322" r="0.5" style="stroke:#000000"/> -<circle cx="141" cy="280" r="0.5" style="stroke:#000000"/> -<circle cx="152" cy="307" r="0.5" style="stroke:#000000"/> -<circle cx="149" cy="322" r="0.5" style="stroke:#000000"/> -<circle cx="151" cy="308" r="0.5" style="stroke:#000000"/> -<circle cx="143" cy="296" r="0.5" style="stroke:#000000"/> -<circle cx="167" cy="323" r="0.5" style="stroke:#000000"/> -<circle cx="154" cy="298" r="0.5" style="stroke:#000000"/> -<circle cx="139" cy="308" r="0.5" style="stroke:#000000"/> -<circle cx="151" cy="299" r="0.5" style="stroke:#000000"/> -<circle cx="150" cy="298" r="0.5" style="stroke:#000000"/> -<circle cx="148" cy="324" r="0.5" style="stroke:#000000"/> -<circle cx="150" cy="301" r="0.5" style="stroke:#000000"/> -<circle cx="146" cy="302" r="0.5" style="stroke:#000000"/> -<circle cx="149" cy="300" r="0.5" style="stroke:#000000"/> -<circle cx="139" cy="314" r="0.5" style="stroke:#000000"/> -<circle cx="168" cy="313" r="0.5" style="stroke:#000000"/> -<circle cx="156" cy="275" r="0.5" style="stroke:#000000"/> -<circle cx="148" cy="321" r="0.5" style="stroke:#000000"/> -<circle cx="152" cy="296" r="0.5" style="stroke:#000000"/> -<circle cx="150" cy="294" r="0.5" style="stroke:#000000"/> -<circle cx="147" cy="305" r="0.5" style="stroke:#000000"/> -<circle cx="148" cy="299" r="0.5" style="stroke:#000000"/> -<circle cx="155" cy="302" r="0.5" style="stroke:#000000"/> -<circle cx="139" cy="301" r="0.5" style="stroke:#000000"/> -<circle cx="155" cy="301" r="0.5" style="stroke:#000000"/> -<circle cx="147" cy="301" r="0.5" style="stroke:#000000"/> -<circle cx="129" cy="313" r="0.5" style="stroke:#000000"/> -<circle cx="169" cy="323" r="0.5" style="stroke:#000000"/> -<circle cx="151" cy="301" r="0.5" style="stroke:#000000"/> -<circle cx="147" cy="302" r="0.5" style="stroke:#000000"/> -<circle cx="177" cy="305" r="0.5" style="stroke:#000000"/> -<circle cx="165" cy="292" r="0.5" style="stroke:#000000"/> -<circle cx="150" cy="300" r="0.5" style="stroke:#000000"/> -<circle cx="139" cy="294" r="0.5" style="stroke:#000000"/> -<circle cx="162" cy="318" r="0.5" style="stroke:#000000"/> -<circle cx="150" cy="300" r="0.5" style="stroke:#000000"/> -<circle cx="150" cy="299" r="0.5" style="stroke:#000000"/> -<circle cx="130" cy="310" r="0.5" style="stroke:#000000"/> -<circle cx="155" cy="302" r="0.5" style="stroke:#000000"/> -<circle cx="160" cy="306" r="0.5" style="stroke:#000000"/> -<circle cx="158" cy="294" r="0.5" style="stroke:#000000"/> -<circle cx="160" cy="291" r="0.5" style="stroke:#000000"/> -<circle cx="158" cy="279" r="0.5" style="stroke:#000000"/> -<circle cx="130" cy="289" r="0.5" style="stroke:#000000"/> -<circle cx="141" cy="295" r="0.5" style="stroke:#000000"/> -<circle cx="152" cy="295" r="0.5" style="stroke:#000000"/> -<circle cx="142" cy="297" r="0.5" style="stroke:#000000"/> -<circle cx="168" cy="309" r="0.5" style="stroke:#000000"/> -<circle cx="155" cy="302" r="0.5" style="stroke:#000000"/> -<circle cx="132" cy="295" r="0.5" style="stroke:#000000"/> -<circle cx="150" cy="300" r="0.5" style="stroke:#000000"/> -<circle cx="163" cy="293" r="0.5" style="stroke:#000000"/> -<circle cx="144" cy="284" r="0.5" style="stroke:#000000"/> -<circle cx="149" cy="290" r="0.5" style="stroke:#000000"/> -<circle cx="146" cy="301" r="0.5" style="stroke:#000000"/> -<circle cx="139" cy="322" r="0.5" style="stroke:#000000"/> -<circle cx="163" cy="286" r="0.5" style="stroke:#000000"/> -<circle cx="142" cy="307" r="0.5" style="stroke:#000000"/> -<circle cx="164" cy="286" r="0.5" style="stroke:#000000"/> -<circle cx="153" cy="325" r="0.5" style="stroke:#000000"/> -<circle cx="147" cy="289" r="0.5" style="stroke:#000000"/> -<circle cx="138" cy="299" r="0.5" style="stroke:#000000"/> -<circle cx="157" cy="306" r="0.5" style="stroke:#000000"/> -<circle cx="158" cy="286" r="0.5" style="stroke:#000000"/> -<circle cx="144" cy="281" r="0.5" style="stroke:#000000"/> -<circle cx="150" cy="280" r="0.5" style="stroke:#000000"/> -<circle cx="151" cy="299" r="0.5" style="stroke:#000000"/> -<circle cx="169" cy="321" r="0.5" style="stroke:#000000"/> -<circle cx="132" cy="305" r="0.5" style="stroke:#000000"/> -<circle cx="153" cy="295" r="0.5" style="stroke:#000000"/> -<circle cx="178" cy="297" r="0.5" style="stroke:#000000"/> -<circle cx="179" cy="295" r="0.5" style="stroke:#000000"/> -<circle cx="149" cy="298" r="0.5" style="stroke:#000000"/> -<circle cx="146" cy="297" r="0.5" style="stroke:#000000"/> -<circle cx="132" cy="290" r="0.5" style="stroke:#000000"/> -<circle cx="153" cy="296" r="0.5" style="stroke:#000000"/> -<circle cx="154" cy="298" r="0.5" style="stroke:#000000"/> -<circle cx="136" cy="293" r="0.5" style="stroke:#000000"/> -<circle cx="175" cy="308" r="0.5" style="stroke:#000000"/> -<circle cx="167" cy="299" r="0.5" style="stroke:#000000"/> -<circle cx="154" cy="290" r="0.5" style="stroke:#000000"/> -<circle cx="133" cy="316" r="0.5" style="stroke:#000000"/> -<circle cx="127" cy="286" r="0.5" style="stroke:#000000"/> -<circle cx="139" cy="292" r="0.5" style="stroke:#000000"/> -<circle cx="148" cy="300" r="0.5" style="stroke:#000000"/> -<circle cx="157" cy="291" r="0.5" style="stroke:#000000"/> -<circle cx="144" cy="273" r="0.5" style="stroke:#000000"/> -<circle cx="131" cy="298" r="0.5" style="stroke:#000000"/> -<circle cx="160" cy="276" r="0.5" style="stroke:#000000"/> -<circle cx="142" cy="317" r="0.5" style="stroke:#000000"/> -<circle cx="148" cy="298" r="0.5" style="stroke:#000000"/> -<circle cx="150" cy="300" r="0.5" style="stroke:#000000"/> -<circle cx="161" cy="318" r="0.5" style="stroke:#000000"/> -<circle cx="150" cy="300" r="0.5" style="stroke:#000000"/> -<circle cx="134" cy="286" r="0.5" style="stroke:#000000"/> -<circle cx="135" cy="309" r="0.5" style="stroke:#000000"/> -<circle cx="129" cy="289" r="0.5" style="stroke:#000000"/> -<circle cx="147" cy="295" r="0.5" style="stroke:#000000"/> -<circle cx="176" cy="300" r="0.5" style="stroke:#000000"/> -<circle cx="145" cy="303" r="0.5" style="stroke:#000000"/> -<circle cx="132" cy="286" r="0.5" style="stroke:#000000"/> -<circle cx="148" cy="299" r="0.5" style="stroke:#000000"/> -<circle cx="152" cy="296" r="0.5" style="stroke:#000000"/> -<circle cx="124" cy="311" r="0.5" style="stroke:#000000"/> -<circle cx="176" cy="302" r="0.5" style="stroke:#000000"/> -<circle cx="148" cy="297" r="0.5" style="stroke:#000000"/> -<circle cx="134" cy="301" r="0.5" style="stroke:#000000"/> -<circle cx="136" cy="316" r="0.5" style="stroke:#000000"/> -<circle cx="148" cy="298" r="0.5" style="stroke:#000000"/> -<circle cx="148" cy="311" r="0.5" style="stroke:#000000"/> -<circle cx="139" cy="322" r="0.5" style="stroke:#000000"/> -<circle cx="159" cy="285" r="0.5" style="stroke:#000000"/> -<circle cx="125" cy="316" r="0.5" style="stroke:#000000"/> -<circle cx="148" cy="328" r="0.5" style="stroke:#000000"/> -<circle cx="178" cy="306" r="0.5" style="stroke:#000000"/> -<circle cx="138" cy="297" r="0.5" style="stroke:#000000"/> -<circle cx="140" cy="284" r="0.5" style="stroke:#000000"/> -<circle cx="173" cy="297" r="0.5" style="stroke:#000000"/> -<circle cx="138" cy="289" r="0.5" style="stroke:#000000"/> -<circle cx="167" cy="287" r="0.5" style="stroke:#000000"/> -<circle cx="495" cy="113" r="0.5" style="stroke:#000000"/> -<circle cx="509" cy="122" r="0.5" style="stroke:#000000"/> -<circle cx="491" cy="135" r="0.5" style="stroke:#000000"/> -<circle cx="487" cy="145" r="0.5" style="stroke:#000000"/> -<circle cx="497" cy="121" r="0.5" style="stroke:#000000"/> -<circle cx="502" cy="142" r="0.5" style="stroke:#000000"/> -<circle cx="515" cy="113" r="0.5" style="stroke:#000000"/> -<circle cx="513" cy="113" r="0.5" style="stroke:#000000"/> -<circle cx="491" cy="105" r="0.5" style="stroke:#000000"/> -<circle cx="509" cy="129" r="0.5" style="stroke:#000000"/> -<circle cx="514" cy="107" r="0.5" style="stroke:#000000"/> -<circle cx="500" cy="120" r="0.5" style="stroke:#000000"/> -<circle cx="504" cy="119" r="0.5" style="stroke:#000000"/> -<circle cx="504" cy="142" r="0.5" style="stroke:#000000"/> -<circle cx="488" cy="126" r="0.5" style="stroke:#000000"/> -<circle cx="515" cy="142" r="0.5" style="stroke:#000000"/> -<circle cx="501" cy="121" r="0.5" style="stroke:#000000"/> -<circle cx="500" cy="115" r="0.5" style="stroke:#000000"/> -<circle cx="500" cy="120" r="0.5" style="stroke:#000000"/> -<circle cx="491" cy="116" r="0.5" style="stroke:#000000"/> -<circle cx="476" cy="112" r="0.5" style="stroke:#000000"/> -<circle cx="486" cy="112" r="0.5" style="stroke:#000000"/> -<circle cx="506" cy="95" r="0.5" style="stroke:#000000"/> -<circle cx="476" cy="112" r="0.5" style="stroke:#000000"/> -<circle cx="485" cy="109" r="0.5" style="stroke:#000000"/> -<circle cx="514" cy="129" r="0.5" style="stroke:#000000"/> -<circle cx="521" cy="136" r="0.5" style="stroke:#000000"/> -<circle cx="504" cy="129" r="0.5" style="stroke:#000000"/> -<circle cx="514" cy="146" r="0.5" style="stroke:#000000"/> -<circle cx="504" cy="103" r="0.5" style="stroke:#000000"/> -<circle cx="491" cy="124" r="0.5" style="stroke:#000000"/> -<circle cx="514" cy="146" r="0.5" style="stroke:#000000"/> -<circle cx="501" cy="108" r="0.5" style="stroke:#000000"/> -<circle cx="486" cy="132" r="0.5" style="stroke:#000000"/> -<circle cx="508" cy="112" r="0.5" style="stroke:#000000"/> -<circle cx="510" cy="122" r="0.5" style="stroke:#000000"/> -<circle cx="495" cy="137" r="0.5" style="stroke:#000000"/> -<circle cx="508" cy="128" r="0.5" style="stroke:#000000"/> -<circle cx="497" cy="115" r="0.5" style="stroke:#000000"/> -<circle cx="497" cy="135" r="0.5" style="stroke:#000000"/> -<circle cx="497" cy="112" r="0.5" style="stroke:#000000"/> -<circle cx="510" cy="124" r="0.5" style="stroke:#000000"/> -<circle cx="494" cy="112" r="0.5" style="stroke:#000000"/> -<circle cx="518" cy="115" r="0.5" style="stroke:#000000"/> -<circle cx="489" cy="114" r="0.5" style="stroke:#000000"/> -<circle cx="480" cy="112" r="0.5" style="stroke:#000000"/> -<circle cx="510" cy="100" r="0.5" style="stroke:#000000"/> -<circle cx="500" cy="120" r="0.5" style="stroke:#000000"/> -<circle cx="516" cy="143" r="0.5" style="stroke:#000000"/> -<circle cx="500" cy="119" r="0.5" style="stroke:#000000"/> -<circle cx="495" cy="127" r="0.5" style="stroke:#000000"/> -<circle cx="495" cy="117" r="0.5" style="stroke:#000000"/> -<circle cx="505" cy="116" r="0.5" style="stroke:#000000"/> -<circle cx="498" cy="114" r="0.5" style="stroke:#000000"/> -<circle cx="502" cy="121" r="0.5" style="stroke:#000000"/> -<circle cx="509" cy="131" r="0.5" style="stroke:#000000"/> -<circle cx="492" cy="120" r="0.5" style="stroke:#000000"/> -<circle cx="521" cy="137" r="0.5" style="stroke:#000000"/> -<circle cx="485" cy="110" r="0.5" style="stroke:#000000"/> -<circle cx="481" cy="118" r="0.5" style="stroke:#000000"/> -<circle cx="501" cy="127" r="0.5" style="stroke:#000000"/> -<circle cx="501" cy="120" r="0.5" style="stroke:#000000"/> -<circle cx="470" cy="119" r="0.5" style="stroke:#000000"/> -<circle cx="497" cy="134" r="0.5" style="stroke:#000000"/> -<circle cx="491" cy="125" r="0.5" style="stroke:#000000"/> -<circle cx="491" cy="110" r="0.5" style="stroke:#000000"/> -<circle cx="517" cy="144" r="0.5" style="stroke:#000000"/> -<circle cx="490" cy="103" r="0.5" style="stroke:#000000"/> -<circle cx="508" cy="99" r="0.5" style="stroke:#000000"/> -<circle cx="505" cy="104" r="0.5" style="stroke:#000000"/> -<circle cx="522" cy="119" r="0.5" style="stroke:#000000"/> -<circle cx="506" cy="143" r="0.5" style="stroke:#000000"/> -<circle cx="514" cy="106" r="0.5" style="stroke:#000000"/> -<circle cx="506" cy="104" r="0.5" style="stroke:#000000"/> -<circle cx="496" cy="118" r="0.5" style="stroke:#000000"/> -<circle cx="490" cy="106" r="0.5" style="stroke:#000000"/> -<circle cx="483" cy="120" r="0.5" style="stroke:#000000"/> -<circle cx="498" cy="124" r="0.5" style="stroke:#000000"/> -<circle cx="499" cy="120" r="0.5" style="stroke:#000000"/> -<circle cx="493" cy="142" r="0.5" style="stroke:#000000"/> -<circle cx="491" cy="100" r="0.5" style="stroke:#000000"/> -<circle cx="502" cy="127" r="0.5" style="stroke:#000000"/> -<circle cx="499" cy="142" r="0.5" style="stroke:#000000"/> -<circle cx="501" cy="128" r="0.5" style="stroke:#000000"/> -<circle cx="493" cy="116" r="0.5" style="stroke:#000000"/> -<circle cx="517" cy="143" r="0.5" style="stroke:#000000"/> -<circle cx="504" cy="118" r="0.5" style="stroke:#000000"/> -<circle cx="489" cy="128" r="0.5" style="stroke:#000000"/> -<circle cx="501" cy="119" r="0.5" style="stroke:#000000"/> -<circle cx="500" cy="118" r="0.5" style="stroke:#000000"/> -<circle cx="498" cy="144" r="0.5" style="stroke:#000000"/> -<circle cx="500" cy="121" r="0.5" style="stroke:#000000"/> -<circle cx="496" cy="122" r="0.5" style="stroke:#000000"/> -<circle cx="499" cy="120" r="0.5" style="stroke:#000000"/> -<circle cx="489" cy="134" r="0.5" style="stroke:#000000"/> -<circle cx="518" cy="133" r="0.5" style="stroke:#000000"/> -<circle cx="506" cy="95" r="0.5" style="stroke:#000000"/> -<circle cx="498" cy="141" r="0.5" style="stroke:#000000"/> -<circle cx="502" cy="116" r="0.5" style="stroke:#000000"/> -<circle cx="500" cy="114" r="0.5" style="stroke:#000000"/> -<circle cx="497" cy="125" r="0.5" style="stroke:#000000"/> -<circle cx="498" cy="119" r="0.5" style="stroke:#000000"/> -<circle cx="505" cy="122" r="0.5" style="stroke:#000000"/> -<circle cx="489" cy="121" r="0.5" style="stroke:#000000"/> -<circle cx="505" cy="121" r="0.5" style="stroke:#000000"/> -<circle cx="497" cy="121" r="0.5" style="stroke:#000000"/> -<circle cx="479" cy="133" r="0.5" style="stroke:#000000"/> -<circle cx="519" cy="143" r="0.5" style="stroke:#000000"/> -<circle cx="501" cy="121" r="0.5" style="stroke:#000000"/> -<circle cx="497" cy="122" r="0.5" style="stroke:#000000"/> -<circle cx="527" cy="125" r="0.5" style="stroke:#000000"/> -<circle cx="515" cy="112" r="0.5" style="stroke:#000000"/> -<circle cx="500" cy="120" r="0.5" style="stroke:#000000"/> -<circle cx="489" cy="114" r="0.5" style="stroke:#000000"/> -<circle cx="512" cy="138" r="0.5" style="stroke:#000000"/> -<circle cx="500" cy="120" r="0.5" style="stroke:#000000"/> -<circle cx="500" cy="119" r="0.5" style="stroke:#000000"/> -<circle cx="480" cy="130" r="0.5" style="stroke:#000000"/> -<circle cx="505" cy="122" r="0.5" style="stroke:#000000"/> -<circle cx="510" cy="126" r="0.5" style="stroke:#000000"/> -<circle cx="508" cy="114" r="0.5" style="stroke:#000000"/> -<circle cx="510" cy="111" r="0.5" style="stroke:#000000"/> -<circle cx="508" cy="99" r="0.5" style="stroke:#000000"/> -<circle cx="480" cy="109" r="0.5" style="stroke:#000000"/> -<circle cx="491" cy="115" r="0.5" style="stroke:#000000"/> -<circle cx="502" cy="115" r="0.5" style="stroke:#000000"/> -<circle cx="492" cy="117" r="0.5" style="stroke:#000000"/> -<circle cx="518" cy="129" r="0.5" style="stroke:#000000"/> -<circle cx="505" cy="122" r="0.5" style="stroke:#000000"/> -<circle cx="482" cy="115" r="0.5" style="stroke:#000000"/> -<circle cx="500" cy="120" r="0.5" style="stroke:#000000"/> -<circle cx="513" cy="113" r="0.5" style="stroke:#000000"/> -<circle cx="494" cy="104" r="0.5" style="stroke:#000000"/> -<circle cx="499" cy="110" r="0.5" style="stroke:#000000"/> -<circle cx="496" cy="121" r="0.5" style="stroke:#000000"/> -<circle cx="489" cy="142" r="0.5" style="stroke:#000000"/> -<circle cx="513" cy="106" r="0.5" style="stroke:#000000"/> -<circle cx="492" cy="127" r="0.5" style="stroke:#000000"/> -<circle cx="514" cy="106" r="0.5" style="stroke:#000000"/> -<circle cx="503" cy="145" r="0.5" style="stroke:#000000"/> -<circle cx="497" cy="109" r="0.5" style="stroke:#000000"/> -<circle cx="488" cy="119" r="0.5" style="stroke:#000000"/> -<circle cx="507" cy="126" r="0.5" style="stroke:#000000"/> -<circle cx="508" cy="106" r="0.5" style="stroke:#000000"/> -<circle cx="494" cy="101" r="0.5" style="stroke:#000000"/> -<circle cx="500" cy="100" r="0.5" style="stroke:#000000"/> -<circle cx="501" cy="119" r="0.5" style="stroke:#000000"/> -<circle cx="519" cy="141" r="0.5" style="stroke:#000000"/> -<circle cx="482" cy="125" r="0.5" style="stroke:#000000"/> -<circle cx="503" cy="115" r="0.5" style="stroke:#000000"/> -<circle cx="528" cy="117" r="0.5" style="stroke:#000000"/> -<circle cx="529" cy="115" r="0.5" style="stroke:#000000"/> -<circle cx="499" cy="118" r="0.5" style="stroke:#000000"/> -<circle cx="496" cy="117" r="0.5" style="stroke:#000000"/> -<circle cx="482" cy="110" r="0.5" style="stroke:#000000"/> -<circle cx="503" cy="116" r="0.5" style="stroke:#000000"/> -<circle cx="504" cy="118" r="0.5" style="stroke:#000000"/> -<circle cx="486" cy="113" r="0.5" style="stroke:#000000"/> -<circle cx="525" cy="128" r="0.5" style="stroke:#000000"/> -<circle cx="517" cy="119" r="0.5" style="stroke:#000000"/> -<circle cx="504" cy="110" r="0.5" style="stroke:#000000"/> -<circle cx="483" cy="136" r="0.5" style="stroke:#000000"/> -<circle cx="477" cy="106" r="0.5" style="stroke:#000000"/> -<circle cx="489" cy="112" r="0.5" style="stroke:#000000"/> -<circle cx="498" cy="120" r="0.5" style="stroke:#000000"/> -<circle cx="507" cy="111" r="0.5" style="stroke:#000000"/> -<circle cx="494" cy="93" r="0.5" style="stroke:#000000"/> -<circle cx="481" cy="118" r="0.5" style="stroke:#000000"/> -<circle cx="510" cy="96" r="0.5" style="stroke:#000000"/> -<circle cx="492" cy="137" r="0.5" style="stroke:#000000"/> -<circle cx="498" cy="118" r="0.5" style="stroke:#000000"/> -<circle cx="500" cy="120" r="0.5" style="stroke:#000000"/> -<circle cx="511" cy="138" r="0.5" style="stroke:#000000"/> -<circle cx="500" cy="120" r="0.5" style="stroke:#000000"/> -<circle cx="484" cy="106" r="0.5" style="stroke:#000000"/> -<circle cx="485" cy="129" r="0.5" style="stroke:#000000"/> -<circle cx="479" cy="109" r="0.5" style="stroke:#000000"/> -<circle cx="497" cy="115" r="0.5" style="stroke:#000000"/> -<circle cx="526" cy="120" r="0.5" style="stroke:#000000"/> -<circle cx="495" cy="123" r="0.5" style="stroke:#000000"/> -<circle cx="482" cy="106" r="0.5" style="stroke:#000000"/> -<circle cx="498" cy="119" r="0.5" style="stroke:#000000"/> -<circle cx="502" cy="116" r="0.5" style="stroke:#000000"/> -<circle cx="474" cy="131" r="0.5" style="stroke:#000000"/> -<circle cx="526" cy="122" r="0.5" style="stroke:#000000"/> -<circle cx="498" cy="117" r="0.5" style="stroke:#000000"/> -<circle cx="484" cy="121" r="0.5" style="stroke:#000000"/> -<circle cx="486" cy="136" r="0.5" style="stroke:#000000"/> -<circle cx="498" cy="118" r="0.5" style="stroke:#000000"/> -<circle cx="498" cy="131" r="0.5" style="stroke:#000000"/> -<circle cx="489" cy="142" r="0.5" style="stroke:#000000"/> -<circle cx="509" cy="105" r="0.5" style="stroke:#000000"/> -<circle cx="475" cy="136" r="0.5" style="stroke:#000000"/> -<circle cx="498" cy="148" r="0.5" style="stroke:#000000"/> -<circle cx="528" cy="126" r="0.5" style="stroke:#000000"/> -<circle cx="488" cy="117" r="0.5" style="stroke:#000000"/> -<circle cx="490" cy="104" r="0.5" style="stroke:#000000"/> -<circle cx="523" cy="117" r="0.5" style="stroke:#000000"/> -<circle cx="488" cy="109" r="0.5" style="stroke:#000000"/> -<circle cx="517" cy="107" r="0.5" style="stroke:#000000"/> -<circle cx="275" cy="163" r="0.5" style="stroke:#000000"/> -<circle cx="345" cy="212" r="0.5" style="stroke:#000000"/> -<circle cx="256" cy="277" r="0.5" style="stroke:#000000"/> -<circle cx="235" cy="324" r="0.5" style="stroke:#000000"/> -<circle cx="286" cy="206" r="0.5" style="stroke:#000000"/> -<circle cx="312" cy="311" r="0.5" style="stroke:#000000"/> -<circle cx="375" cy="163" r="0.5" style="stroke:#000000"/> -<circle cx="363" cy="164" r="0.5" style="stroke:#000000"/> -<circle cx="254" cy="126" r="0.5" style="stroke:#000000"/> -<circle cx="343" cy="243" r="0.5" style="stroke:#000000"/> -<circle cx="372" cy="133" r="0.5" style="stroke:#000000"/> -<circle cx="301" cy="201" r="0.5" style="stroke:#000000"/> -<circle cx="319" cy="193" r="0.5" style="stroke:#000000"/> -<circle cx="319" cy="311" r="0.5" style="stroke:#000000"/> -<circle cx="238" cy="232" r="0.5" style="stroke:#000000"/> -<circle cx="376" cy="310" r="0.5" style="stroke:#000000"/> -<circle cx="305" cy="203" r="0.5" style="stroke:#000000"/> -<circle cx="299" cy="177" r="0.5" style="stroke:#000000"/> -<circle cx="300" cy="201" r="0.5" style="stroke:#000000"/> -<circle cx="256" cy="179" r="0.5" style="stroke:#000000"/> -<circle cx="182" cy="162" r="0.5" style="stroke:#000000"/> -<circle cx="229" cy="158" r="0.5" style="stroke:#000000"/> -<circle cx="328" cy="75" r="0.5" style="stroke:#000000"/> -<circle cx="180" cy="161" r="0.5" style="stroke:#000000"/> -<circle cx="225" cy="144" r="0.5" style="stroke:#000000"/> -<circle cx="369" cy="245" r="0.5" style="stroke:#000000"/> -<circle cx="406" cy="282" r="0.5" style="stroke:#000000"/> -<circle cx="320" cy="245" r="0.5" style="stroke:#000000"/> -<circle cx="369" cy="328" r="0.5" style="stroke:#000000"/> -<circle cx="318" cy="115" r="0.5" style="stroke:#000000"/> -<circle cx="253" cy="221" r="0.5" style="stroke:#000000"/> -<circle cx="369" cy="332" r="0.5" style="stroke:#000000"/> -<circle cx="303" cy="140" r="0.5" style="stroke:#000000"/> -<circle cx="231" cy="259" r="0.5" style="stroke:#000000"/> -<circle cx="342" cy="159" r="0.5" style="stroke:#000000"/> -<circle cx="348" cy="208" r="0.5" style="stroke:#000000"/> -<circle cx="273" cy="283" r="0.5" style="stroke:#000000"/> -<circle cx="342" cy="241" r="0.5" style="stroke:#000000"/> -<circle cx="284" cy="177" r="0.5" style="stroke:#000000"/> -<circle cx="283" cy="276" r="0.5" style="stroke:#000000"/> -<circle cx="284" cy="159" r="0.5" style="stroke:#000000"/> -<circle cx="348" cy="222" r="0.5" style="stroke:#000000"/> -<circle cx="269" cy="159" r="0.5" style="stroke:#000000"/> -<circle cx="388" cy="175" r="0.5" style="stroke:#000000"/> -<circle cx="245" cy="172" r="0.5" style="stroke:#000000"/> -<circle cx="200" cy="158" r="0.5" style="stroke:#000000"/> -<circle cx="351" cy="99" r="0.5" style="stroke:#000000"/> -<circle cx="300" cy="201" r="0.5" style="stroke:#000000"/> -<circle cx="379" cy="317" r="0.5" style="stroke:#000000"/> -<circle cx="301" cy="197" r="0.5" style="stroke:#000000"/> -<circle cx="277" cy="236" r="0.5" style="stroke:#000000"/> -<circle cx="275" cy="187" r="0.5" style="stroke:#000000"/> -<circle cx="324" cy="178" r="0.5" style="stroke:#000000"/> -<circle cx="292" cy="168" r="0.5" style="stroke:#000000"/> -<circle cx="312" cy="204" r="0.5" style="stroke:#000000"/> -<circle cx="345" cy="255" r="0.5" style="stroke:#000000"/> -<circle cx="262" cy="198" r="0.5" style="stroke:#000000"/> -<circle cx="403" cy="283" r="0.5" style="stroke:#000000"/> -<circle cx="223" cy="152" r="0.5" style="stroke:#000000"/> -<circle cx="207" cy="189" r="0.5" style="stroke:#000000"/> -<circle cx="305" cy="237" r="0.5" style="stroke:#000000"/> -<circle cx="303" cy="200" r="0.5" style="stroke:#000000"/> -<circle cx="150" cy="197" r="0.5" style="stroke:#000000"/> -<circle cx="286" cy="268" r="0.5" style="stroke:#000000"/> -<circle cx="254" cy="227" r="0.5" style="stroke:#000000"/> -<circle cx="254" cy="152" r="0.5" style="stroke:#000000"/> -<circle cx="387" cy="322" r="0.5" style="stroke:#000000"/> -<circle cx="250" cy="117" r="0.5" style="stroke:#000000"/> -<circle cx="341" cy="97" r="0.5" style="stroke:#000000"/> -<circle cx="327" cy="122" r="0.5" style="stroke:#000000"/> -<circle cx="412" cy="193" r="0.5" style="stroke:#000000"/> -<circle cx="329" cy="315" r="0.5" style="stroke:#000000"/> -<circle cx="372" cy="130" r="0.5" style="stroke:#000000"/> -<circle cx="328" cy="120" r="0.5" style="stroke:#000000"/> -<circle cx="279" cy="190" r="0.5" style="stroke:#000000"/> -<circle cx="248" cy="132" r="0.5" style="stroke:#000000"/> -<circle cx="213" cy="199" r="0.5" style="stroke:#000000"/> -<circle cx="291" cy="218" r="0.5" style="stroke:#000000"/> -<circle cx="297" cy="200" r="0.5" style="stroke:#000000"/> -<circle cx="264" cy="309" r="0.5" style="stroke:#000000"/> -<circle cx="257" cy="100" r="0.5" style="stroke:#000000"/> -<circle cx="308" cy="235" r="0.5" style="stroke:#000000"/> -<circle cx="296" cy="312" r="0.5" style="stroke:#000000"/> -<circle cx="305" cy="240" r="0.5" style="stroke:#000000"/> -<circle cx="264" cy="178" r="0.5" style="stroke:#000000"/> -<circle cx="383" cy="317" r="0.5" style="stroke:#000000"/> -<circle cx="319" cy="189" r="0.5" style="stroke:#000000"/> -<circle cx="247" cy="241" r="0.5" style="stroke:#000000"/> -<circle cx="306" cy="193" r="0.5" style="stroke:#000000"/> -<circle cx="302" cy="190" r="0.5" style="stroke:#000000"/> -<circle cx="292" cy="319" r="0.5" style="stroke:#000000"/> -<circle cx="298" cy="203" r="0.5" style="stroke:#000000"/> -<circle cx="280" cy="211" r="0.5" style="stroke:#000000"/> -<circle cx="296" cy="202" r="0.5" style="stroke:#000000"/> -<circle cx="243" cy="272" r="0.5" style="stroke:#000000"/> -<circle cx="392" cy="263" r="0.5" style="stroke:#000000"/> -<circle cx="331" cy="74" r="0.5" style="stroke:#000000"/> -<circle cx="292" cy="303" r="0.5" style="stroke:#000000"/> -<circle cx="310" cy="181" r="0.5" style="stroke:#000000"/> -<circle cx="302" cy="168" r="0.5" style="stroke:#000000"/> -<circle cx="287" cy="227" r="0.5" style="stroke:#000000"/> -<circle cx="288" cy="196" r="0.5" style="stroke:#000000"/> -<circle cx="326" cy="210" r="0.5" style="stroke:#000000"/> -<circle cx="244" cy="206" r="0.5" style="stroke:#000000"/> -<circle cx="325" cy="205" r="0.5" style="stroke:#000000"/> -<circle cx="287" cy="206" r="0.5" style="stroke:#000000"/> -<circle cx="194" cy="265" r="0.5" style="stroke:#000000"/> -<circle cx="397" cy="314" r="0.5" style="stroke:#000000"/> -<circle cx="307" cy="204" r="0.5" style="stroke:#000000"/> -<circle cx="286" cy="212" r="0.5" style="stroke:#000000"/> -<circle cx="436" cy="227" r="0.5" style="stroke:#000000"/> -<circle cx="373" cy="161" r="0.5" style="stroke:#000000"/> -<circle cx="298" cy="199" r="0.5" style="stroke:#000000"/> -<circle cx="244" cy="172" r="0.5" style="stroke:#000000"/> -<circle cx="360" cy="290" r="0.5" style="stroke:#000000"/> -<circle cx="299" cy="202" r="0.5" style="stroke:#000000"/> -<circle cx="300" cy="195" r="0.5" style="stroke:#000000"/> -<circle cx="201" cy="252" r="0.5" style="stroke:#000000"/> -<circle cx="323" cy="210" r="0.5" style="stroke:#000000"/> -<circle cx="350" cy="228" r="0.5" style="stroke:#000000"/> -<circle cx="341" cy="170" r="0.5" style="stroke:#000000"/> -<circle cx="349" cy="157" r="0.5" style="stroke:#000000"/> -<circle cx="340" cy="94" r="0.5" style="stroke:#000000"/> -<circle cx="202" cy="147" r="0.5" style="stroke:#000000"/> -<circle cx="254" cy="174" r="0.5" style="stroke:#000000"/> -<circle cx="309" cy="176" r="0.5" style="stroke:#000000"/> -<circle cx="260" cy="183" r="0.5" style="stroke:#000000"/> -<circle cx="391" cy="243" r="0.5" style="stroke:#000000"/> -<circle cx="326" cy="210" r="0.5" style="stroke:#000000"/> -<circle cx="210" cy="175" r="0.5" style="stroke:#000000"/> -<circle cx="300" cy="200" r="0.5" style="stroke:#000000"/> -<circle cx="364" cy="163" r="0.5" style="stroke:#000000"/> -<circle cx="271" cy="121" r="0.5" style="stroke:#000000"/> -<circle cx="294" cy="149" r="0.5" style="stroke:#000000"/> -<circle cx="278" cy="205" r="0.5" style="stroke:#000000"/> -<circle cx="245" cy="311" r="0.5" style="stroke:#000000"/> -<circle cx="363" cy="131" r="0.5" style="stroke:#000000"/> -<circle cx="262" cy="236" r="0.5" style="stroke:#000000"/> -<circle cx="369" cy="128" r="0.5" style="stroke:#000000"/> -<circle cx="317" cy="327" r="0.5" style="stroke:#000000"/> -<circle cx="283" cy="143" r="0.5" style="stroke:#000000"/> -<circle cx="239" cy="194" r="0.5" style="stroke:#000000"/> -<circle cx="333" cy="231" r="0.5" style="stroke:#000000"/> -<circle cx="340" cy="129" r="0.5" style="stroke:#000000"/> -<circle cx="271" cy="105" r="0.5" style="stroke:#000000"/> -<circle cx="302" cy="100" r="0.5" style="stroke:#000000"/> -<circle cx="303" cy="197" r="0.5" style="stroke:#000000"/> -<circle cx="395" cy="303" r="0.5" style="stroke:#000000"/> -<circle cx="210" cy="227" r="0.5" style="stroke:#000000"/> -<circle cx="317" cy="174" r="0.5" style="stroke:#000000"/> -<circle cx="441" cy="184" r="0.5" style="stroke:#000000"/> -<circle cx="447" cy="175" r="0.5" style="stroke:#000000"/> -<circle cx="294" cy="191" r="0.5" style="stroke:#000000"/> -<circle cx="281" cy="184" r="0.5" style="stroke:#000000"/> -<circle cx="212" cy="148" r="0.5" style="stroke:#000000"/> -<circle cx="315" cy="179" r="0.5" style="stroke:#000000"/> -<circle cx="318" cy="190" r="0.5" style="stroke:#000000"/> -<circle cx="232" cy="164" r="0.5" style="stroke:#000000"/> -<circle cx="425" cy="239" r="0.5" style="stroke:#000000"/> -<circle cx="387" cy="195" r="0.5" style="stroke:#000000"/> -<circle cx="322" cy="152" r="0.5" style="stroke:#000000"/> -<circle cx="213" cy="278" r="0.5" style="stroke:#000000"/> -<circle cx="187" cy="132" r="0.5" style="stroke:#000000"/> -<circle cx="245" cy="161" r="0.5" style="stroke:#000000"/> -<circle cx="292" cy="202" r="0.5" style="stroke:#000000"/> -<circle cx="336" cy="155" r="0.5" style="stroke:#000000"/> -<circle cx="272" cy="65" r="0.5" style="stroke:#000000"/> -<circle cx="204" cy="190" r="0.5" style="stroke:#000000"/> -<circle cx="351" cy="82" r="0.5" style="stroke:#000000"/> -<circle cx="259" cy="284" r="0.5" style="stroke:#000000"/> -<circle cx="288" cy="189" r="0.5" style="stroke:#000000"/> -<circle cx="300" cy="200" r="0.5" style="stroke:#000000"/> -<circle cx="353" cy="288" r="0.5" style="stroke:#000000"/> -<circle cx="301" cy="199" r="0.5" style="stroke:#000000"/> -<circle cx="218" cy="128" r="0.5" style="stroke:#000000"/> -<circle cx="226" cy="243" r="0.5" style="stroke:#000000"/> -<circle cx="195" cy="146" r="0.5" style="stroke:#000000"/> -<circle cx="284" cy="174" r="0.5" style="stroke:#000000"/> -<circle cx="428" cy="200" r="0.5" style="stroke:#000000"/> -<circle cx="274" cy="214" r="0.5" style="stroke:#000000"/> -<circle cx="211" cy="131" r="0.5" style="stroke:#000000"/> -<circle cx="291" cy="196" r="0.5" style="stroke:#000000"/> -<circle cx="310" cy="180" r="0.5" style="stroke:#000000"/> -<circle cx="172" cy="257" r="0.5" style="stroke:#000000"/> -<circle cx="431" cy="212" r="0.5" style="stroke:#000000"/> -<circle cx="290" cy="187" r="0.5" style="stroke:#000000"/> -<circle cx="219" cy="203" r="0.5" style="stroke:#000000"/> -<circle cx="230" cy="279" r="0.5" style="stroke:#000000"/> -<circle cx="291" cy="192" r="0.5" style="stroke:#000000"/> -<circle cx="291" cy="254" r="0.5" style="stroke:#000000"/> -<circle cx="245" cy="309" r="0.5" style="stroke:#000000"/> -<circle cx="345" cy="126" r="0.5" style="stroke:#000000"/> -<circle cx="175" cy="278" r="0.5" style="stroke:#000000"/> -<circle cx="289" cy="338" r="0.5" style="stroke:#000000"/> -<circle cx="442" cy="228" r="0.5" style="stroke:#000000"/> -<circle cx="242" cy="186" r="0.5" style="stroke:#000000"/> -<circle cx="249" cy="120" r="0.5" style="stroke:#000000"/> -<circle cx="415" cy="186" r="0.5" style="stroke:#000000"/> -<circle cx="242" cy="145" r="0.5" style="stroke:#000000"/> -<circle cx="384" cy="133" r="0.5" style="stroke:#000000"/> -<circle cx="20" cy="98" r="1" style="stroke:#ff0000"/> -<circle cx="50" cy="246" r="1" style="stroke:#ff0000"/> -<circle cx="83" cy="354" r="1" style="stroke:#ff0000"/> -<circle cx="164" cy="416" r="1" style="stroke:#ff0000"/> -<circle cx="236" cy="434" r="1" style="stroke:#ff0000"/> -<circle cx="343" cy="427" r="1" style="stroke:#ff0000"/> -<circle cx="366" cy="412" r="1" style="stroke:#ff0000"/> -<circle cx="379" cy="402" r="1" style="stroke:#ff0000"/> -<circle cx="519" cy="143" r="1" style="stroke:#ff0000"/> -<circle cx="528" cy="126" r="1" style="stroke:#ff0000"/> -<circle cx="529" cy="115" r="1" style="stroke:#ff0000"/> -<circle cx="510" cy="96" r="1" style="stroke:#ff0000"/> -<circle cx="506" cy="95" r="1" style="stroke:#ff0000"/> -<circle cx="117" cy="33" r="1" style="stroke:#ff0000"/> -<circle cx="85" cy="28" r="1" style="stroke:#ff0000"/> -<circle cx="40" cy="64" r="1" style="stroke:#ff0000"/> -</svg> diff --git a/testsuite/tests/dph/quickhull/dph-quickhull.T b/testsuite/tests/dph/quickhull/dph-quickhull.T deleted file mode 100644 index 7d8cf322ab..0000000000 --- a/testsuite/tests/dph/quickhull/dph-quickhull.T +++ /dev/null @@ -1,20 +0,0 @@ - -test ('dph-quickhull-copy-fast' - , [ outputdir('copy-fast') - , reqlib('dph-lifted-copy') - , reqlib('dph-prim-par') - , only_ways(['normal', 'threaded1', 'threaded2']) ] - , multimod_compile_and_run - , [ 'Main' - , '-O0 -fno-vectorisation-avoidance -package dph-lifted-copy -package dph-prim-par']) - - -test ('dph-quickhull-vseg-fast' - , [ outputdir('vseg-fast') - , reqlib('dph-lifted-vseg') - , reqlib('dph-prim-par') - , only_ways(['normal', 'threaded1', 'threaded2']) ] - , multimod_compile_and_run - , [ 'Main' - , '-O0 -package dph-lifted-vseg -package dph-prim-par']) - diff --git a/testsuite/tests/dph/smvm/Main.hs b/testsuite/tests/dph/smvm/Main.hs deleted file mode 100644 index d6b9a0f55c..0000000000 --- a/testsuite/tests/dph/smvm/Main.hs +++ /dev/null @@ -1,60 +0,0 @@ -{-# LANGUAGE TypeOperators #-} - -import SMVMVect (smvm) - -import Control.Exception (evaluate) -import System.IO -import System.Environment - -import qualified Data.Array.Parallel.Unlifted as U -import Data.Array.Parallel.Prelude -import Data.Array.Parallel.PArray as P - - --- Load sparse matrix from a file -loadSM :: String - -> IO (PArray (PArray (Int, Double)), PArray Double) - -loadSM s - = do - (segd, m, v) <- loadSM' s - return $ (nestUSegd segd (fromUArray2 m), fromUArray v) - - -loadSM' :: String - -> IO ( U.Segd - , U.Array (Int, Double) - , U.Array Double) -loadSM' fname = - do - h <- openBinaryFile fname ReadMode - lengths <- U.hGet h - indices <- U.hGet h - values <- U.hGet h - dv <- U.hGet h - let segd = U.lengthsToSegd lengths - m = U.zip indices values - evaluate lengths - evaluate indices - evaluate values - evaluate dv - return (segd, m, dv) - -main - = do [inFile, outFile] <- getArgs - (m, v) <- loadSM inFile - let result = smvm m v - - -- ignore wibbles in low-order bits - let output - = (unlines - $ map (take 12) - $ map show - $ P.toList result) - ++ ("SUM = " - ++ (take 12 $ show $ sum $ P.toList result) - ++ "\n") - - -- check our result against the provided outFile - outputCheck <- readFile outFile - print $ output == outputCheck diff --git a/testsuite/tests/dph/smvm/Makefile b/testsuite/tests/dph/smvm/Makefile deleted file mode 100644 index 9101fbd40a..0000000000 --- a/testsuite/tests/dph/smvm/Makefile +++ /dev/null @@ -1,3 +0,0 @@ -TOP=../../.. -include $(TOP)/mk/boilerplate.mk -include $(TOP)/mk/test.mk diff --git a/testsuite/tests/dph/smvm/SMVMVect.hs b/testsuite/tests/dph/smvm/SMVMVect.hs deleted file mode 100644 index 93f3775741..0000000000 --- a/testsuite/tests/dph/smvm/SMVMVect.hs +++ /dev/null @@ -1,17 +0,0 @@ -{-# LANGUAGE ParallelArrays #-} -{-# OPTIONS -fvectorise #-} -module SMVMVect (smvm) where - -import Data.Array.Parallel -import Data.Array.Parallel.Prelude.Double as D -import Data.Array.Parallel.Prelude.Int as I - -import qualified Prelude as P - -smvm :: PArray (PArray (Int, Double)) -> PArray Double -> PArray Double -{-# NOINLINE smvm #-} -smvm m v = toPArrayP (smvm' (fromNestedPArrayP m) (fromPArrayP v)) - -smvm' :: [:[: (Int, Double) :]:] -> [:Double:] -> [:Double:] -smvm' m v = [: D.sumP [: x D.* (v !: i) | (i,x) <- row :] | row <- m :] - diff --git a/testsuite/tests/dph/smvm/dph-smvm.T b/testsuite/tests/dph/smvm/dph-smvm.T deleted file mode 100644 index f2bf31ab82..0000000000 --- a/testsuite/tests/dph/smvm/dph-smvm.T +++ /dev/null @@ -1,41 +0,0 @@ - - -testFile = 'nothing' -if config.platform.startswith('i386-'): - testFile = 'test-i386.dat' - outFile = 'result-i386.txt' - -elif config.platform.startswith('x86_64-'): - testFile = 'test-x86_64.dat' - outFile = 'result-x86_64.txt' - -elif config.platform.startswith('sparc-'): - testFile = 'test-sparc.dat' - outFile = 'result-sparc.txt' - - -if testFile != 'nothing': - test ('dph-smvm-copy' - , [ outputdir('copy') - , when(fast(), skip) - , reqlib('dph-lifted-copy') - , reqlib('dph-prim-par') - , only_ways(['normal', 'threaded1', 'threaded2']) - , extra_run_opts(testFile + " " + outFile) - ] - , multimod_compile_and_run - , [ 'Main' - , '-O0 -package dph-lifted-copy -package dph-prim-par']) - - test ('dph-smvm-vseg' - , [ outputdir('vseg') - , when(fast(), skip) - , reqlib('dph-lifted-vseg') - , reqlib('dph-prim-par') - , only_ways(['normal', 'threaded1', 'threaded2']) - , extra_run_opts(testFile + " " + outFile) - ] - , multimod_compile_and_run - , [ 'Main' - , '-O0 -package dph-lifted-vseg -package dph-prim-par']) - diff --git a/testsuite/tests/dph/smvm/result-i386.txt b/testsuite/tests/dph/smvm/result-i386.txt deleted file mode 100644 index bf279482ef..0000000000 --- a/testsuite/tests/dph/smvm/result-i386.txt +++ /dev/null @@ -1,101 +0,0 @@ -70.911036010 -6.2813390683 -22.790766463 -138.15513262 -52.633427554 -23.459671609 -39.794269586 -37.387466366 -16.666309389 -86.252836326 -2.0045195528 -89.578046705 -15.195705417 -14.397637033 -9.9571970137 -12.966919776 -314.12848526 -106.92515769 -53.308659874 -187.71842503 -19.814258245 -3.5465802997 -26.462654791 -39.989634289 -27.636953710 -14.238025227 -43.040256543 -2.1571625382 -67.541648911 -24.912387408 -7.6904324146 -2.9650091269 -48.668083695 -56.313556473 -285.31615184 -25.595785904 -49.488178849 -25.310153120 -10.706428715 -80.585871589 -225.85945599 -27.813502732 -36.745192736 -157.41617010 -51.501091484 -30.457678049 -254.13030691 -17.469473192 -60.702335620 -52.376229564 -26.517446882 -46.939308590 -19.961999016 -226.11502829 -69.361878263 -206.34127990 -59.002071706 -23.815778535 -101.90955813 -0.3802732664 -41.728371059 -12.021386376 -20.282213202 -17.500045961 -19.148201048 -73.983800195 -7.6944408324 -20.993610043 -58.350721826 -67.038534218 -31.260033960 -14.283638817 -140.68179300 -31.766861701 -46.639106640 -5.2416016510 -175.49192085 -6.1624941117 -3.0550277985 -51.818892673 -7.8677940322 -22.311195092 -258.22325771 -47.475395836 -104.78223912 -38.825154663 -1.6611687222 -63.278567845 -139.86840253 -72.273773546 -71.487712807 -46.823777361 -125.50127870 -3.7203037750 -48.211248191 -79.659040149 -59.672472372 -73.220258924 -63.910310588 -23.405170831 -SUM = 6054.6294998 diff --git a/testsuite/tests/dph/smvm/result-sparc.txt b/testsuite/tests/dph/smvm/result-sparc.txt deleted file mode 100644 index 8c85795cbc..0000000000 --- a/testsuite/tests/dph/smvm/result-sparc.txt +++ /dev/null @@ -1,101 +0,0 @@ -31.171134675 -136.96399669 -99.558688941 -2.3944559306 -132.07457337 -64.316928783 -17.141482371 -363.11345177 -12.350699032 -62.403552077 -25.836846192 -488.62415222 -90.786181827 -2650.5823673 -28.153073045 -29.698154931 -280.42051630 -264.68315963 -0.0 -17.241401450 -103.44167214 -120.25222269 -0.6481556022 -3.8143291874 -57.942419415 -0.9485226158 -11.722857133 -80.685346313 -497.97232376 -7.3021493591 -0.0 -4.9013220836 -61.582851534 -104.83102162 -12.196177619 -16.799924219 -8.8828491057 -20.672947720 -0.0 -8.9693097972 -66.272730332 -145.39838263 -2.6011327691 -80.289657428 -17.075494290 -0.5897431148 -26.250003553 -114.75531349 -57.010466242 -38.222004332 -5.6130133753 -120.90679901 -106.19820538 -0.0 -22.471060597 -50.616335208 -0.7352665245 -13.632854738 -72.201368578 -54.552907983 -3.2165935380 -31.048444965 -3.3117670262 -224.93467543 -110.02973746 -2.0467456318 -0.0 -7.2930317411 -8.6809940997 -41.756667327 -118.07161086 -358.47370477 -8.1013874742 -9.1189573118 -35.367265915 -10.245691446 -25.785856741 -55.679020534 -83.594437531 -34.102347192 -0.2950061972 -16.641363479 -0.0 -29.534024840 -0.0 -26.338163918 -149.17642877 -0.1698288578 -24.176530881 -57.626923103 -33.976034955 -15.977447399 -0.0 -893.79869661 -117.52170252 -60.450794548 -0.5763239875 -4.9690229931 -14.014097678 -275.53547442 -SUM = 9808.1107603 diff --git a/testsuite/tests/dph/smvm/result-x86_64.txt b/testsuite/tests/dph/smvm/result-x86_64.txt deleted file mode 100644 index ebad60a2b0..0000000000 --- a/testsuite/tests/dph/smvm/result-x86_64.txt +++ /dev/null @@ -1,101 +0,0 @@ -2.3160849869 -26.283679649 -76.729994661 -405.68040155 -55.723673494 -33.938026665 -26.505926115 -52.261424813 -33.397325696 -1.1328178441 -5.3697979892 -9.4419428065 -28.678826876 -61.019008268 -4.5301894841 -43.464645691 -0.0 -34.335714653 -20.798359422 -16.561984995 -17.581964787 -23.948149350 -19.120544306 -30.215710069 -0.7009196726 -51.297030554 -4.4591823094 -209.96809687 -47.289681980 -32.498492600 -13.196267290 -0.9989265108 -1.0341069617 -38.917182375 -7.9955088012 -10.355804741 -20.095073245 -36.647037472 -18.786308469 -14.370553796 -6.3265152208 -28.117268967 -65.265404040 -898.53639610 -2.1015959321 -188.65890412 -31.810545943 -14.182075117 -16.239269064 -27.309800346 -126.26472539 -32.948733352 -20.290181336 -0.0 -40.083403468 -81.626718007 -141.59574874 -8.5797914307 -37.726704414 -0.5807127190 -6.3771256902 -6.3486182511 -5.8655193980 -8.1395223932 -32.695645766 -16.964781766 -5.2863815777 -31.967858939 -21.161490986 -61.257464383 -4.1240057418 -18.099623432 -2.1851562467 -3.7220913984 -55.452918211 -10.289474473 -46.276301220 -23.201718136 -7.6338488432 -45.868472148 -12.976885901 -18.483762115 -143.50458515 -24.999794955 -12.121764180 -6.7194800847 -1.8693415211 -23.848562170 -1092.0362340 -67.588787350 -248.07913042 -0.0 -38.838570262 -13.800391661 -1277.9084108 -53.491216504 -14.325720303 -10.152650478 -17.439312837 -40.696348267 -SUM = 6837.6898296 diff --git a/testsuite/tests/dph/smvm/test-i386.dat b/testsuite/tests/dph/smvm/test-i386.dat Binary files differdeleted file mode 100644 index 4db8d62620..0000000000 --- a/testsuite/tests/dph/smvm/test-i386.dat +++ /dev/null diff --git a/testsuite/tests/dph/smvm/test-sparc.dat b/testsuite/tests/dph/smvm/test-sparc.dat Binary files differdeleted file mode 100644 index 73d2c201cd..0000000000 --- a/testsuite/tests/dph/smvm/test-sparc.dat +++ /dev/null diff --git a/testsuite/tests/dph/smvm/test-x86_64.dat b/testsuite/tests/dph/smvm/test-x86_64.dat Binary files differdeleted file mode 100644 index 08a91f5ab1..0000000000 --- a/testsuite/tests/dph/smvm/test-x86_64.dat +++ /dev/null diff --git a/testsuite/tests/dph/sumnats/Main.hs b/testsuite/tests/dph/sumnats/Main.hs deleted file mode 100644 index 7c3ee7210b..0000000000 --- a/testsuite/tests/dph/sumnats/Main.hs +++ /dev/null @@ -1,21 +0,0 @@ - -import SumNatsVect (sumNats) - --- Solution for 1st Euler problem --- Add all the natural numbers below 1000 that are multiples of 3 or 5. - -solutionLists maxN - = let sumOnetoN n = n * (n+1) `div` 2 - sumStep s n = s * sumOnetoN (n `div` s) - in sumStep 3 (maxN - 1) + sumStep 5 (maxN - 1) - sumStep 15 (maxN - 1) - -solutionLists2 maxN - = sum [ x | x <- [0.. maxN - 1] - , (x `mod` 3 == 0) || (x `mod` 5 == 0) ] - -main - = do let n = 1000 - print $ solutionLists n - print $ solutionLists2 n - print $ sumNats n - diff --git a/testsuite/tests/dph/sumnats/Makefile b/testsuite/tests/dph/sumnats/Makefile deleted file mode 100644 index 9101fbd40a..0000000000 --- a/testsuite/tests/dph/sumnats/Makefile +++ /dev/null @@ -1,3 +0,0 @@ -TOP=../../.. -include $(TOP)/mk/boilerplate.mk -include $(TOP)/mk/test.mk diff --git a/testsuite/tests/dph/sumnats/SumNatsVect.hs b/testsuite/tests/dph/sumnats/SumNatsVect.hs deleted file mode 100644 index 187946da4e..0000000000 --- a/testsuite/tests/dph/sumnats/SumNatsVect.hs +++ /dev/null @@ -1,14 +0,0 @@ -{-# LANGUAGE ParallelArrays #-} -{-# OPTIONS -fvectorise #-} -module SumNatsVect (sumNats) where - -import Data.Array.Parallel.Prelude -import Data.Array.Parallel.Prelude.Int as I - -import qualified Prelude as P - -sumNats :: Int -> Int -sumNats maxN - = sumP [: x | x <- enumFromToP 0 (maxN I.- 1) - , (x `mod` 3 I.== 0) || (x `mod` 5 I.== 0) :] - diff --git a/testsuite/tests/dph/sumnats/dph-sumnats-copy.stdout b/testsuite/tests/dph/sumnats/dph-sumnats-copy.stdout deleted file mode 100644 index 8858be2164..0000000000 --- a/testsuite/tests/dph/sumnats/dph-sumnats-copy.stdout +++ /dev/null @@ -1,3 +0,0 @@ -233168 -233168 -233168 diff --git a/testsuite/tests/dph/sumnats/dph-sumnats-vseg.stdout b/testsuite/tests/dph/sumnats/dph-sumnats-vseg.stdout deleted file mode 100644 index 8858be2164..0000000000 --- a/testsuite/tests/dph/sumnats/dph-sumnats-vseg.stdout +++ /dev/null @@ -1,3 +0,0 @@ -233168 -233168 -233168 diff --git a/testsuite/tests/dph/sumnats/dph-sumnats.T b/testsuite/tests/dph/sumnats/dph-sumnats.T deleted file mode 100644 index 66e4b404d6..0000000000 --- a/testsuite/tests/dph/sumnats/dph-sumnats.T +++ /dev/null @@ -1,20 +0,0 @@ - -test ('dph-sumnats-copy' - , [ outputdir('copy') - , reqlib('dph-lifted-copy') - , reqlib('dph-prim-par') - , only_ways(['normal', 'threaded1', 'threaded2']) ] - , multimod_compile_and_run - , [ 'Main' - , '-O0 -package dph-lifted-copy']) - - -test ('dph-sumnats-vseg' - , [ outputdir('vseg') - , reqlib('dph-lifted-vseg') - , reqlib('dph-prim-par') - , only_ways(['normal', 'threaded1', 'threaded2']) ] - , multimod_compile_and_run - , [ 'Main' - , '-O0 -package dph-lifted-vseg']) - diff --git a/testsuite/tests/dph/words/Main.hs b/testsuite/tests/dph/words/Main.hs deleted file mode 100644 index b7c266921f..0000000000 --- a/testsuite/tests/dph/words/Main.hs +++ /dev/null @@ -1,37 +0,0 @@ - -import WordsVect -import Data.Array.Parallel -import qualified Data.Array.Parallel.Prelude.Word8 as W -import qualified Data.Array.Parallel.PArray as P -import qualified Data.Array.Parallel.Unlifted as U -import Data.Char - -main - = do -- take the filename containing the words as the first arg - let str = "When I look into the looking glass I'm always sure to see" - ++ " no matter how I dodge about, me looking back at me." - - -- convert string to a PArray - let paStr :: PArray W.Word8 - paStr = P.fromUArray $ U.map W.fromInt $ U.fromList $ map ord str - - - -- break the string into words then flatten it back - let str' :: String - str' = map chr - $ map fromIntegral - $ P.toList - $ wordsOfPArray paStr - - - -- count the number of words in the string, using the vectorised program - let wordCountVect = fromIntegral $ wordCountOfPArray paStr - - -- count the number of words with the ye'olde list way - let wordCountList = length $ words str - - -- - putStr $ show str' ++ "\n" - ++ "word count vect = " ++ show wordCountVect ++ "\n" - ++ "word count lists = " ++ show wordCountList ++ "\n" - diff --git a/testsuite/tests/dph/words/Makefile b/testsuite/tests/dph/words/Makefile deleted file mode 100644 index 9101fbd40a..0000000000 --- a/testsuite/tests/dph/words/Makefile +++ /dev/null @@ -1,3 +0,0 @@ -TOP=../../.. -include $(TOP)/mk/boilerplate.mk -include $(TOP)/mk/test.mk diff --git a/testsuite/tests/dph/words/WordsVect.hs b/testsuite/tests/dph/words/WordsVect.hs deleted file mode 100644 index 218e885dac..0000000000 --- a/testsuite/tests/dph/words/WordsVect.hs +++ /dev/null @@ -1,125 +0,0 @@ - --- Break up a string into words in parallel. --- Based on the presentation "Breaking Sequential Habits of Thought", Guy Steele. --- http://groups.csail.mit.edu/mac/users/gjs/6.945/readings/MITApril2009Steele.pdf --- --- NOTE: This is a naive implementation, and I haven't benchmarked it. --- Using parallel arrays in Seg probably isn't helpful for performance, --- but it's a stress test for the vectoriser. --- --- If we actually cared about performance we wouldn't want to recursively --- subdivide the string right down to individual characters. --- -{-# LANGUAGE ParallelArrays, ParallelListComp #-} -{-# OPTIONS -fvectorise #-} - -module WordsVect - ( wordsOfPArray - , wordCountOfPArray ) -where -import qualified Data.Array.Parallel.Prelude.Word8 as W -import Data.Array.Parallel.Prelude.Word8 (Word8) -import Data.Array.Parallel.Prelude.Int as I -import Data.Array.Parallel - -import qualified Prelude as Prel - - --- We can't use the Prelude Char and String types in vectorised code yet.. -type Char = Word8 -char_space = W.fromInt 32 - -type String = [: Char :] - - --- | Word state -data State - = Chunk String - | Seg String -- initial word chunk - [:String:] -- complete words in the middle of the segment - String -- final word chunk - - --- | Compose two wordstates. -plusState :: State -> State -> State -plusState str1 str2 - = case (str1, str2) of - (Chunk as, Chunk bs) -> Chunk (as +:+ bs) - (Chunk as, Seg bl bss br) -> Seg (as +:+ bl) bss br - (Seg al ass ar, Chunk bs) -> Seg al ass (ar +:+ bs) - (Seg al ass ar, Seg bl bss br) -> Seg al (ass +:+ joinEmpty [:ar +:+ bl:] +:+ bss) br - -joinEmpty :: [:[:Word8:]:] -> [:[:Word8:]:] -joinEmpty ws - | lengthP ws I.== 1 && lengthP (ws !: 0) I.== 0 = [::] - | otherwise = ws - - --- | Convert a single char to a wordstate. -stateOfChar :: Char -> State -stateOfChar c - | c W.== char_space = Seg [::] [::] [::] - | otherwise = Chunk [:c:] - - --- | Break this string into words. -stateOfString :: String -> State -stateOfString str - = let len = lengthP str - result - | len I.== 0 = Chunk [::] - | len I.== 1 = stateOfChar (str !: 0) - | otherwise - = let half = len `div` 2 - s1 = sliceP 0 half str - s2 = sliceP half (len I.- half) str - in plusState (stateOfString s1) (stateOfString s2) - in result - - --- | Count the number of words in a string. -countWordsOfState :: State -> Int -countWordsOfState state - = case state of - Chunk c -> wordsInChunkArr c - Seg c1 ws c2 -> wordsInChunkArr c1 I.+ lengthP ws I.+ wordsInChunkArr c2 - -wordsInChunkArr :: [:Word8:] -> Int -wordsInChunkArr arr - | lengthP arr I.== 0 = 0 - | otherwise = 1 - - --- | Flatten a state back to an array of Word8s, --- inserting spaces between the words. -flattenState :: State -> [:Word8:] -flattenState ss - = case ss of - Chunk s -> s - - Seg w1 ws w2 - -> w1 - +:+ [:char_space:] - +:+ concatP [: w +:+ [:char_space:] | w <- ws :] - +:+ w2 - --- Interface ------------------------------------------------------------------ - --- | Break up an array of chars into words then flatten it back. -wordsOfPArray :: PArray Word8 -> PArray Word8 -{-# NOINLINE wordsOfPArray #-} -wordsOfPArray arr - = let str = fromPArrayP arr - state = stateOfString str - strOut = flattenState state - in toPArrayP strOut - - --- | Count the number of words in an array -wordCountOfPArray :: PArray Word8 -> Int -{-# NOINLINE wordCountOfPArray #-} -wordCountOfPArray arr - = let str = fromPArrayP arr - state = stateOfString str - in countWordsOfState state - diff --git a/testsuite/tests/dph/words/dph-words-copy-fast.stdout b/testsuite/tests/dph/words/dph-words-copy-fast.stdout deleted file mode 100644 index a7ad9be6b6..0000000000 --- a/testsuite/tests/dph/words/dph-words-copy-fast.stdout +++ /dev/null @@ -1,3 +0,0 @@ -"When I look into the looking glass I'm always sure to see no matter how I dodge about, me looking back at me." -word count vect = 23 -word count lists = 23 diff --git a/testsuite/tests/dph/words/dph-words-copy-opt.stdout b/testsuite/tests/dph/words/dph-words-copy-opt.stdout deleted file mode 100644 index a7ad9be6b6..0000000000 --- a/testsuite/tests/dph/words/dph-words-copy-opt.stdout +++ /dev/null @@ -1,3 +0,0 @@ -"When I look into the looking glass I'm always sure to see no matter how I dodge about, me looking back at me." -word count vect = 23 -word count lists = 23 diff --git a/testsuite/tests/dph/words/dph-words-vseg-fast.stdout b/testsuite/tests/dph/words/dph-words-vseg-fast.stdout deleted file mode 100644 index a7ad9be6b6..0000000000 --- a/testsuite/tests/dph/words/dph-words-vseg-fast.stdout +++ /dev/null @@ -1,3 +0,0 @@ -"When I look into the looking glass I'm always sure to see no matter how I dodge about, me looking back at me." -word count vect = 23 -word count lists = 23 diff --git a/testsuite/tests/dph/words/dph-words-vseg-opt.stdout b/testsuite/tests/dph/words/dph-words-vseg-opt.stdout deleted file mode 100644 index a7ad9be6b6..0000000000 --- a/testsuite/tests/dph/words/dph-words-vseg-opt.stdout +++ /dev/null @@ -1,3 +0,0 @@ -"When I look into the looking glass I'm always sure to see no matter how I dodge about, me looking back at me." -word count vect = 23 -word count lists = 23 diff --git a/testsuite/tests/dph/words/dph-words.T b/testsuite/tests/dph/words/dph-words.T deleted file mode 100644 index 7173278914..0000000000 --- a/testsuite/tests/dph/words/dph-words.T +++ /dev/null @@ -1,20 +0,0 @@ - -test ('dph-words-copy-fast' - , [ outputdir('copy-fast') - , reqlib('dph-lifted-copy') - , reqlib('dph-prim-par') - , only_ways(['normal']) ] - , multimod_compile_and_run - , [ 'Main' - , '-O0 -package dph-lifted-copy -package dph-prim-par']) - - -test ('dph-words-vseg-fast' - , [ outputdir('vseg-fast') - , reqlib('dph-lifted-vseg') - , reqlib('dph-prim-par') - , only_ways(['normal']) ] - , multimod_compile_and_run - , [ 'Main' - , '-O0 -package dph-lifted-vseg -package dph-prim-par']) - diff --git a/testsuite/tests/driver/Makefile b/testsuite/tests/driver/Makefile index ffb924adb5..540f158b14 100644 --- a/testsuite/tests/driver/Makefile +++ b/testsuite/tests/driver/Makefile @@ -619,6 +619,14 @@ T10320: "$(TEST_HC)" $(TEST_HC_OPTS) -v0 -fforce-recomp -ddump-to-file -ddump-rule-rewrites T10320.hs [ -f T10320.dump-rule-rewrites ] && [ ! -s T10320.dump-rule-rewrites ] +.PHONY: T10869 +T10869: + $(RM) -rf T10869.hi T10869.o T10869.hspp T10869 + $(RM) -rf T10869A.hi T10869A.o T10869A.hspp + "$(TEST_HC)" $(TEST_HC_OPTS) -c -keep-hscpp-files T10869A.hs T10869.hs + test -f T10869.hscpp + test -f T10869A.hscpp + .PHONY: T12135 T12135: $(RM) -rf T12135.o T12135.hi T12135 T12135a T12135b @@ -637,6 +645,20 @@ T10923: # should NOT output "compilation is NOT required" "$(TEST_HC)" $(TEST_HC_OPTS) -v1 -O -c T10923.hs +.PHONY: T13604 +T13604: + $(RM) -rf T13604.o T13604.hi + "$(TEST_HC)" $(TEST_HC_OPTS) -v1 -O0 -c T13604.hs + # SHOULD output "compilation is NOT required" + "$(TEST_HC)" $(TEST_HC_OPTS) -v1 -O -c -fignore-optim-changes T13604.hs + +.PHONY: T13604a +T13604a: + $(RM) -rf T13604a.o T13604a.hi + "$(TEST_HC)" $(TEST_HC_OPTS) -v1 -O0 -c -fhpc T13604a.hs + # SHOULD output "compilation is NOT required" + "$(TEST_HC)" $(TEST_HC_OPTS) -v1 -O0 -c -fignore-hpc-changes T13604a.hs + .PHONY: T12955 T12955: ! "$(TEST_HC)" $(TEST_HC_OPTS) --make T12955 diff --git a/testsuite/tests/driver/T10869.hs b/testsuite/tests/driver/T10869.hs new file mode 100644 index 0000000000..e1518544b2 --- /dev/null +++ b/testsuite/tests/driver/T10869.hs @@ -0,0 +1,9 @@ +{-# LANGUAGE CPP #-} + +module T10869 where +import T10869A + +main :: IO() +#if defined(__GLASGOW_HASKELL__) +main = writeMsg +#endif diff --git a/testsuite/tests/driver/T10869A.hs b/testsuite/tests/driver/T10869A.hs new file mode 100644 index 0000000000..14e57772c7 --- /dev/null +++ b/testsuite/tests/driver/T10869A.hs @@ -0,0 +1,7 @@ +{-# LANGUAGE CPP #-} +module T10869A (writeMsg) where + +writeMsg :: IO () +#if defined(__GLASGOW_HASKELL__) +writeMsg = putStrLn "Hello HSPP File" +#endif diff --git a/testsuite/tests/driver/T10970.stdout b/testsuite/tests/driver/T10970.stdout index 96362170dd..bf26c89bd8 100644 --- a/testsuite/tests/driver/T10970.stdout +++ b/testsuite/tests/driver/T10970.stdout @@ -1,2 +1,2 @@ -0.5.10.2 +0.6.0.1 OK diff --git a/testsuite/tests/driver/T12625.hs b/testsuite/tests/driver/T12625.hs new file mode 100644 index 0000000000..b34b9142d7 --- /dev/null +++ b/testsuite/tests/driver/T12625.hs @@ -0,0 +1,2 @@ +main :: IO() +main = putStrLn "T12625" diff --git a/testsuite/tests/driver/T12625.stderr b/testsuite/tests/driver/T12625.stderr new file mode 100644 index 0000000000..a171dbda90 --- /dev/null +++ b/testsuite/tests/driver/T12625.stderr @@ -0,0 +1,2 @@ +ghc: on the commandline: missing argument for flag: -I +Usage: For basic information, try the `--help' option. diff --git a/testsuite/tests/driver/T12674/-T12674.hs b/testsuite/tests/driver/T12674/-T12674.hs new file mode 100644 index 0000000000..11a7c546bd --- /dev/null +++ b/testsuite/tests/driver/T12674/-T12674.hs @@ -0,0 +1,10 @@ +{-# LANGUAGE ForeignFunctionInterface, CPP #-} +import Foreign.C +foreign import ccall unsafe "test" test :: CInt -> IO () + +main :: IO () +-- Use conditional language to test passing a file with a filename +-- starting with a hyphen to the preprocessor. +#if defined(__GLASGOW_HASKELL__) +main = test 3 +#endif diff --git a/testsuite/tests/driver/T12674/-T12674c.c b/testsuite/tests/driver/T12674/-T12674c.c new file mode 100644 index 0000000000..3b38c5879e --- /dev/null +++ b/testsuite/tests/driver/T12674/-T12674c.c @@ -0,0 +1,6 @@ +#include <stdio.h> +void test(int arg +) +{ + printf("Result %i\n", arg ); +} diff --git a/testsuite/tests/driver/T12674/T12674.stdout b/testsuite/tests/driver/T12674/T12674.stdout new file mode 100644 index 0000000000..76239dd5cb --- /dev/null +++ b/testsuite/tests/driver/T12674/T12674.stdout @@ -0,0 +1 @@ +Result 3 diff --git a/testsuite/tests/driver/T12674/T12674w.stdout b/testsuite/tests/driver/T12674/T12674w.stdout new file mode 100644 index 0000000000..76239dd5cb --- /dev/null +++ b/testsuite/tests/driver/T12674/T12674w.stdout @@ -0,0 +1 @@ +Result 3 diff --git a/testsuite/tests/driver/T12674/all.T b/testsuite/tests/driver/T12674/all.T new file mode 100644 index 0000000000..0f9e205c9f --- /dev/null +++ b/testsuite/tests/driver/T12674/all.T @@ -0,0 +1,5 @@ +test('T12674', [extra_files(['-T12674.hs', '-T12674c.c'])], + multi_compile, ['./-T12674.hs', [('././-T12674c.c', '')], '-v0']) +test('T12674w', [extra_files(['-T12674.hs', '-T12674c.c']), + unless(opsys('mingw32'), skip)], + multi_compile, ['.\\\-T12674.hs', [('.\\\.\\\-T12674c.c', '')], '-v0']) diff --git a/testsuite/tests/driver/T13604.hs b/testsuite/tests/driver/T13604.hs new file mode 100644 index 0000000000..d98fb588ab --- /dev/null +++ b/testsuite/tests/driver/T13604.hs @@ -0,0 +1 @@ +module T13604 where diff --git a/testsuite/tests/driver/T13604.stdout b/testsuite/tests/driver/T13604.stdout new file mode 100644 index 0000000000..ae02c1f7a8 --- /dev/null +++ b/testsuite/tests/driver/T13604.stdout @@ -0,0 +1 @@ +compilation IS NOT required diff --git a/testsuite/tests/driver/T13604a.hs b/testsuite/tests/driver/T13604a.hs new file mode 100644 index 0000000000..ea79324743 --- /dev/null +++ b/testsuite/tests/driver/T13604a.hs @@ -0,0 +1 @@ +module T13604a where diff --git a/testsuite/tests/driver/T13604a.stdout b/testsuite/tests/driver/T13604a.stdout new file mode 100644 index 0000000000..ae02c1f7a8 --- /dev/null +++ b/testsuite/tests/driver/T13604a.stdout @@ -0,0 +1 @@ +compilation IS NOT required diff --git a/testsuite/tests/driver/T13710/A.hs b/testsuite/tests/driver/T13710/A.hs new file mode 100644 index 0000000000..5181945eeb --- /dev/null +++ b/testsuite/tests/driver/T13710/A.hs @@ -0,0 +1,5 @@ +{-# LANGUAGE RecordWildCards #-} +module A where +import B +data E = MkE +p (H{..}) = () diff --git a/testsuite/tests/driver/T13710/A.hs-boot b/testsuite/tests/driver/T13710/A.hs-boot new file mode 100644 index 0000000000..94a2f5e306 --- /dev/null +++ b/testsuite/tests/driver/T13710/A.hs-boot @@ -0,0 +1,2 @@ +module A ( E ) where +data E diff --git a/testsuite/tests/driver/T13710/B.hs b/testsuite/tests/driver/T13710/B.hs new file mode 100644 index 0000000000..87c93a9f39 --- /dev/null +++ b/testsuite/tests/driver/T13710/B.hs @@ -0,0 +1,3 @@ +module B where +import {-# SOURCE #-} A +data H = H { h :: E } diff --git a/testsuite/tests/dph/dotp/Makefile b/testsuite/tests/driver/T13710/Makefile index 9101fbd40a..d582f94af5 100644 --- a/testsuite/tests/dph/dotp/Makefile +++ b/testsuite/tests/driver/T13710/Makefile @@ -1,3 +1,6 @@ TOP=../../.. include $(TOP)/mk/boilerplate.mk include $(TOP)/mk/test.mk + +T13710: + '$(TEST_HC)' $(TEST_HC_OPTS) --make B.hs diff --git a/testsuite/tests/driver/T13710/T13710.stdout b/testsuite/tests/driver/T13710/T13710.stdout new file mode 100644 index 0000000000..2d729289db --- /dev/null +++ b/testsuite/tests/driver/T13710/T13710.stdout @@ -0,0 +1,3 @@ +[1 of 3] Compiling A[boot] ( A.hs-boot, A.o-boot ) +[2 of 3] Compiling B ( B.hs, B.o ) +[3 of 3] Compiling A ( A.hs, A.o ) diff --git a/testsuite/tests/driver/T13710/all.T b/testsuite/tests/driver/T13710/all.T new file mode 100644 index 0000000000..64daacc96b --- /dev/null +++ b/testsuite/tests/driver/T13710/all.T @@ -0,0 +1,4 @@ +test('T13710', + [extra_files(['A.hs', 'A.hs-boot', 'B.hs'])], + run_command, + ['$MAKE -s --no-print-directory T13710']) diff --git a/testsuite/tests/driver/T13914/T13914.stdout b/testsuite/tests/driver/T13914/T13914.stdout index 04d14aa293..d443ed47b9 100644 --- a/testsuite/tests/driver/T13914/T13914.stdout +++ b/testsuite/tests/driver/T13914/T13914.stdout @@ -5,11 +5,11 @@ main: Assertion failed CallStack (from HasCallStack): assert, called at main.hs:3:8 in main:Main With -fignore-asserts -[1 of 1] Compiling Main ( main.hs, main.o ) [flags changed] +[1 of 1] Compiling Main ( main.hs, main.o ) [Optimisation flags changed] Linking main ... OK Without -fignore-asserts -[1 of 1] Compiling Main ( main.hs, main.o ) [flags changed] +[1 of 1] Compiling Main ( main.hs, main.o ) [Optimisation flags changed] Linking main ... main: Assertion failed CallStack (from HasCallStack): diff --git a/testsuite/tests/driver/T14075/F.hs b/testsuite/tests/driver/T14075/F.hs new file mode 100644 index 0000000000..3e32036eb4 --- /dev/null +++ b/testsuite/tests/driver/T14075/F.hs @@ -0,0 +1 @@ +module F () where diff --git a/testsuite/tests/driver/T14075/F.hs-boot b/testsuite/tests/driver/T14075/F.hs-boot new file mode 100644 index 0000000000..41008d554f --- /dev/null +++ b/testsuite/tests/driver/T14075/F.hs-boot @@ -0,0 +1,6 @@ +module F where + +import O (O) + +newtype F = F () +instance O F where diff --git a/testsuite/tests/dph/enumfromto/Makefile b/testsuite/tests/driver/T14075/Makefile index 9101fbd40a..505274a181 100644 --- a/testsuite/tests/dph/enumfromto/Makefile +++ b/testsuite/tests/driver/T14075/Makefile @@ -1,3 +1,6 @@ TOP=../../.. include $(TOP)/mk/boilerplate.mk include $(TOP)/mk/test.mk + +T14075: + ! '$(TEST_HC)' $(TEST_HC_OPTS) -j2 F O V diff --git a/testsuite/tests/driver/T14075/O.hs b/testsuite/tests/driver/T14075/O.hs new file mode 100644 index 0000000000..2cbb8bb0ef --- /dev/null +++ b/testsuite/tests/driver/T14075/O.hs @@ -0,0 +1,3 @@ +module O (O) where + +class O a where diff --git a/testsuite/tests/driver/T14075/T14075.stderr b/testsuite/tests/driver/T14075/T14075.stderr new file mode 100644 index 0000000000..0493a96f12 --- /dev/null +++ b/testsuite/tests/driver/T14075/T14075.stderr @@ -0,0 +1,7 @@ + +F.hs:1:1: error: + instance O.O F.F -- Defined at F.hs-boot:6:10 + is defined in the hs-boot file, but not in the module itself + +F.hs-boot:5:1: error: + ‘F.F’ is exported by the hs-boot file, but not exported by the module diff --git a/testsuite/tests/driver/T14075/T14075.stdout b/testsuite/tests/driver/T14075/T14075.stdout new file mode 100644 index 0000000000..18f17be1ee --- /dev/null +++ b/testsuite/tests/driver/T14075/T14075.stdout @@ -0,0 +1,3 @@ +[1 of 4] Compiling O ( O.hs, O.o ) +[2 of 4] Compiling F[boot] ( F.hs-boot, F.o-boot ) +[3 of 4] Compiling F ( F.hs, F.o ) diff --git a/testsuite/tests/driver/T14075/V.hs b/testsuite/tests/driver/T14075/V.hs new file mode 100644 index 0000000000..cf06b93dcc --- /dev/null +++ b/testsuite/tests/driver/T14075/V.hs @@ -0,0 +1,3 @@ +module V () where + +import {-# SOURCE #-} F () diff --git a/testsuite/tests/driver/T14075/V.hs-boot b/testsuite/tests/driver/T14075/V.hs-boot new file mode 100644 index 0000000000..ec64e228fc --- /dev/null +++ b/testsuite/tests/driver/T14075/V.hs-boot @@ -0,0 +1 @@ +module V where diff --git a/testsuite/tests/driver/T14075/all.T b/testsuite/tests/driver/T14075/all.T new file mode 100644 index 0000000000..646976a5b2 --- /dev/null +++ b/testsuite/tests/driver/T14075/all.T @@ -0,0 +1,4 @@ +test('T14075', + [extra_files(['F.hs', 'F.hs-boot', 'O.hs', 'V.hs', 'V.hs-boot'])], + run_command, + ['$MAKE -s --no-print-directory T14075']) diff --git a/testsuite/tests/driver/T15396.hs b/testsuite/tests/driver/T15396.hs new file mode 100644 index 0000000000..9ab9f6e6e6 --- /dev/null +++ b/testsuite/tests/driver/T15396.hs @@ -0,0 +1,8 @@ +{-# LANGUAGE OverloadedStrings #-} +import Ar + +-- obtained from echo -n \0 > x.o && ar -q b.a x.o && cat b.a +archive = "!<arch>\nx.o/ 0 0 0 644 1 \ +\`\n0\nx.o/ 0 0 0 644 1 `\n0\n" + +main = print (parseAr archive) diff --git a/testsuite/tests/driver/T15396.stdout b/testsuite/tests/driver/T15396.stdout new file mode 100644 index 0000000000..65edafad23 --- /dev/null +++ b/testsuite/tests/driver/T15396.stdout @@ -0,0 +1 @@ +Archive [ArchiveEntry {filename = "x.o", filetime = 0, fileown = 0, filegrp = 0, filemode = 644, filesize = 1, filedata = "0"},ArchiveEntry {filename = "x.o", filetime = 0, fileown = 0, filegrp = 0, filemode = 644, filesize = 1, filedata = "0"}] diff --git a/testsuite/tests/driver/T3007/Makefile b/testsuite/tests/driver/T3007/Makefile index 09db27a38f..52b3331af1 100644 --- a/testsuite/tests/driver/T3007/Makefile +++ b/testsuite/tests/driver/T3007/Makefile @@ -11,11 +11,11 @@ clean: T3007: $(MAKE) -s --no-print-directory clean '$(GHC_PKG)' init package.conf - cd A && '$(TEST_HC)' -v0 --make Setup + cd A && '$(TEST_HC)' $(TEST_HC_OPTS) -v0 --make Setup cd A && ./Setup configure -v0 --with-compiler='$(TEST_HC)' --ghc-pkg-option=--global-package-db=../package.conf --ghc-option=-package-db../package.conf cd A && ./Setup build -v0 cd A && ./Setup register --inplace -v0 - cd B && '$(TEST_HC)' -v0 --make Setup + cd B && '$(TEST_HC)' $(TEST_HC_OPTS) -v0 --make Setup cd B && ./Setup configure -v0 --with-compiler='$(TEST_HC)' --ghc-pkg-option=--global-package-db=../package.conf --ghc-option=-package-db../package.conf cd B && ./Setup build -v0 diff --git a/testsuite/tests/driver/T3007/all.T b/testsuite/tests/driver/T3007/all.T index bd9046cdd8..803357ba02 100644 --- a/testsuite/tests/driver/T3007/all.T +++ b/testsuite/tests/driver/T3007/all.T @@ -1 +1,4 @@ -test('T3007', [extra_files(['A/', 'B/'])], run_command, ['$MAKE -s --no-print-directory T3007']) +test('T3007', + extra_files(['A/', 'B/']), + run_command, + ['$MAKE -s --no-print-directory T3007']) diff --git a/testsuite/tests/driver/T4437.hs b/testsuite/tests/driver/T4437.hs index 3ae39d1ca2..2818851444 100644 --- a/testsuite/tests/driver/T4437.hs +++ b/testsuite/tests/driver/T4437.hs @@ -39,8 +39,9 @@ expectedGhcOnlyExtensions :: [String] expectedGhcOnlyExtensions = ["RelaxedLayout", "AlternativeLayoutRule", "AlternativeLayoutRuleTransitional", - "UnboxedSums", - "DerivingStrategies"] + "DerivingVia", + "EmptyDataDeriving", + "GeneralisedNewtypeDeriving"] expectedCabalOnlyExtensions :: [String] expectedCabalOnlyExtensions = ["Generics", diff --git a/testsuite/tests/driver/T8526/T8526.stdout b/testsuite/tests/driver/T8526/T8526.stdout index 83b8f9593d..0255fa3b85 100644 --- a/testsuite/tests/driver/T8526/T8526.stdout +++ b/testsuite/tests/driver/T8526/T8526.stdout @@ -1,6 +1,6 @@ [1 of 1] Compiling A ( A.hs, interpreted ) -Ok, 1 module loaded. +Ok, one module loaded. True [1 of 1] Compiling A ( A.hs, interpreted ) -Ok, 1 module loaded. +Ok, one module loaded. False diff --git a/testsuite/tests/driver/T9776.stderr b/testsuite/tests/driver/T9776.stderr index 328a105e61..0281a2d0c4 100644 --- a/testsuite/tests/driver/T9776.stderr +++ b/testsuite/tests/driver/T9776.stderr @@ -1,2 +1,2 @@ -ghc-stage2: on the commandline: missing argument for flag: -frule-check +ghc-stage2: on the commandline: missing argument for flag: -drule-check Usage: For basic information, try the `--help' option. diff --git a/testsuite/tests/driver/all.T b/testsuite/tests/driver/all.T index 19dcc0a950..be91a261d8 100644 --- a/testsuite/tests/driver/all.T +++ b/testsuite/tests/driver/all.T @@ -172,8 +172,8 @@ fobject_code = when(doing_ghci(), extra_hc_opts('-fobject-code')) test( 'T4114a', fobject_code, compile_and_run, ['-cpp']) test( 'T4114b', fobject_code, compile_and_run, ['-no-keep-hi-files']) -test( 'T4114c', fobject_code, compile_and_run, ['-no-keep-o-files']) -test( 'T4114d', fobject_code, compile_and_run, +test( 'T4114c', [fobject_code, expect_broken_for(4114, ['ghci'])], compile_and_run, ['-no-keep-o-files']) +test( 'T4114d', [fobject_code, expect_broken_for(4114, ['ghci'])], compile_and_run, ['-hisuf .myhi -osuf .myo -no-keep-o-files']) test('T5584', [], run_command, ['$MAKE -s --no-print-directory T5584']) @@ -214,7 +214,7 @@ test('write_interface_oneshot', [extra_files(['A011.hs'])], run_command, test('write_interface_make', [extra_files(['A011.hs'])], run_command, ['$MAKE -s --no-print-directory write_interface_make']) -test('T9776', normal, compile_fail, ['-frule-check']) +test('T9776', normal, compile_fail, ['-drule-check']) test('T9938', [], run_command, ['$MAKE -s --no-print-directory T9938']) @@ -234,6 +234,8 @@ test('T10220', normal, run_command, test('T10182', [], run_command, ['$MAKE -s --no-print-directory T10182']) +test('T10869', [], run_command, ['$MAKE -s --no-print-directory T10869']) + test('T365', [pre_cmd('touch test_preprocessor.txt'), unless(opsys('mingw32'), skip)], compile_fail, ['']) @@ -264,6 +266,8 @@ test('T12192', normal, run_command, ['mkdir foo && (cd foo && {compiler} -v0 ../ test('T10923', [], run_command, ['$MAKE -s --no-print-directory T10923']) +test('T12625', normal, compile_fail, ['-I']) + test('T12752pass', normal, compile, ['-DSHOULD_PASS=1 -Wcpp-undef']) test('T12955', normal, run_command, ['$MAKE -s --no-print-directory T12955']) @@ -271,3 +275,12 @@ test('T12955', normal, run_command, ['$MAKE -s --no-print-directory T12955']) test('T12971', ignore_stdout, run_command, ['$MAKE -s --no-print-directory T12971']) test('json', normal, compile_fail, ['-ddump-json']) test('json2', normal, compile, ['-ddump-types -ddump-json']) +test('T13604', [], run_command, ['$MAKE -s --no-print-directory T13604']) +test('T13604a', [], run_command, ['$MAKE -s --no-print-directory T13604a']) +# omitting hpc and profasm because they affect the +# inlining and unfoldings +test('inline-check', omit_ways(['hpc', 'profasm']) + , compile + , ['-dinline-check foo -O -ddebug-output']) + +test('T15396', normal, compile_and_run, ['-package ghc']) diff --git a/testsuite/tests/driver/inline-check.hs b/testsuite/tests/driver/inline-check.hs new file mode 100644 index 0000000000..83112e1226 --- /dev/null +++ b/testsuite/tests/driver/inline-check.hs @@ -0,0 +1,12 @@ +module InlineCheck where + +foo = (+1) + +foo1 = (+1) +{-# NOINLINE foo1 #-} + +qux = foo 3 + +qux1 = foo1 3 + +too = qux diff --git a/testsuite/tests/driver/inline-check.stderr b/testsuite/tests/driver/inline-check.stderr new file mode 100644 index 0000000000..5bf9edaf24 --- /dev/null +++ b/testsuite/tests/driver/inline-check.stderr @@ -0,0 +1,26 @@ +Considering inlining: foo + arg infos [ValueArg] + interesting continuation RhsCtxt + some_benefit True + is exp: True + is work-free: True + guidance IF_ARGS [0] 30 0 + discounted size = 10 + ANSWER = YES +Inactive unfolding: foo1 +Inactive unfolding: foo1 +Inactive unfolding: foo1 +Inactive unfolding: foo1 +Inactive unfolding: foo1 +Inactive unfolding: foo1 +Inactive unfolding: foo1 +Inactive unfolding: foo1 +Considering inlining: foo + arg infos [] + interesting continuation RhsCtxt + some_benefit False + is exp: True + is work-free: True + guidance ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=False) + ANSWER = NO +Inactive unfolding: foo1 diff --git a/testsuite/tests/driver/json.stderr b/testsuite/tests/driver/json.stderr index ff3915a654..61a55e09d0 100644 --- a/testsuite/tests/driver/json.stderr +++ b/testsuite/tests/driver/json.stderr @@ -1,8 +1 @@ - -json.hs:6:7: error: - • No instance for (Num (a -> a)) arising from the literal ‘5’ - (maybe you haven't applied a function to enough arguments?) - • In the expression: 5 - In an equation for ‘id1’: id1 = 5 -[ - {"span": {"file": "json.hs","startLine": 6,"startCol": 7,"endLine": 6,"endCol": 8},"doc": "\u2022 No instance for (Num (a -> a)) arising from the literal \u20185\u2019\n (maybe you haven't applied a function to enough arguments?)\n\u2022 In the expression: 5\n In an equation for \u2018id1\u2019: id1 = 5","severity": "SevError","reason": null}] +{"span": {"file": "json.hs","startLine": 6,"startCol": 7,"endLine": 6,"endCol": 8},"doc": "\u2022 No instance for (Num (a -> a)) arising from the literal \u20185\u2019\n (maybe you haven't applied a function to enough arguments?)\n\u2022 In the expression: 5\n In an equation for \u2018id1\u2019: id1 = 5","severity": "SevError","reason": null} diff --git a/testsuite/tests/driver/json2.stderr b/testsuite/tests/driver/json2.stderr index f511d97b57..bf7f80a579 100644 --- a/testsuite/tests/driver/json2.stderr +++ b/testsuite/tests/driver/json2.stderr @@ -1,9 +1 @@ -TYPE SIGNATURES - foo :: forall a. a -> a -TYPE CONSTRUCTORS -COERCION AXIOMS -Dependent modules: [] -Dependent packages: [base-4.10.0.0, ghc-prim-0.5.1.0, - integer-gmp-1.0.0.1] -[ - {"span": null,"doc": "TYPE SIGNATURES\n foo :: forall a. a -> a\nTYPE CONSTRUCTORS\nCOERCION AXIOMS\nDependent modules: []\nDependent packages: [base-4.10.0.0, ghc-prim-0.5.1.0,\n integer-gmp-1.0.0.1]","severity": "SevOutput","reason": null}] +{"span": null,"doc": "TYPE SIGNATURES\n foo :: forall a. a -> a\nTYPE CONSTRUCTORS\nCOERCION AXIOMS\nDependent modules: []\nDependent packages: [base-4.12.0.0, ghc-prim-0.5.3,\n integer-gmp-1.0.2.0]","severity": "SevOutput","reason": null} diff --git a/testsuite/tests/driver/linkwhole/all.T b/testsuite/tests/driver/linkwhole/all.T index 294a87934a..1562aa82c6 100644 --- a/testsuite/tests/driver/linkwhole/all.T +++ b/testsuite/tests/driver/linkwhole/all.T @@ -1,3 +1,5 @@ -test('linkwhole', [extra_files(['Types.hs','Main.hs','MyCode.hs','Handles.hs']), - when(opsys('mingw32'), skip)], +test('linkwhole', + [extra_files(['Types.hs','Main.hs','MyCode.hs','Handles.hs']), + when(arch('powerpc64') or arch('powerpc64le'), expect_broken(11259)), + when(opsys('mingw32'), skip)], run_command, ['$MAKE -s --no-print-directory linkwhole']) diff --git a/testsuite/tests/driver/recomp015/all.T b/testsuite/tests/driver/recomp015/all.T index e0b77f3cce..9399534c4e 100644 --- a/testsuite/tests/driver/recomp015/all.T +++ b/testsuite/tests/driver/recomp015/all.T @@ -2,7 +2,6 @@ test('recomp015', [extra_files(['Generate.hs']), - clean_cmd('$MAKE -s clean'), # See ticket:11022#comment:7 unless(opsys('linux') or opsys('solaris2') or opsys('openbsd'), skip), when(arch('arm'), skip), diff --git a/testsuite/tests/driver/retc001/all.T b/testsuite/tests/driver/retc001/all.T index 3f15ed1654..a5b0c827e1 100644 --- a/testsuite/tests/driver/retc001/all.T +++ b/testsuite/tests/driver/retc001/all.T @@ -1,6 +1,5 @@ test('retc001', [extra_files(['A.hs', 'B1.hs', 'B2.hs', 'C.hs']), - clean_cmd('$MAKE -s clean'), # See issue 11204, this test sometimes passes and sometimes fails on OSX when(opsys('darwin'), skip)], run_command, diff --git a/testsuite/tests/dynlibs/Makefile b/testsuite/tests/dynlibs/Makefile index 2f5620c73b..e3af7503e7 100644 --- a/testsuite/tests/dynlibs/Makefile +++ b/testsuite/tests/dynlibs/Makefile @@ -52,3 +52,9 @@ T5373: -./T5373C +RTS -c 2>&1 | grep disabled -./T5373D +RTS -c 2>&1 | grep disabled +.PHONY: T13702 +T13702: + '$(TEST_HC)' -v0 -dynamic -rdynamic -fPIC -pie T13702.hs + '$(TEST_HC)' -v0 -dynamic T13702a.hs + ./T13702 # first make sure executable itself works + ./T13702a # then try dynamically loading it as library diff --git a/testsuite/tests/dynlibs/T13702.hs b/testsuite/tests/dynlibs/T13702.hs new file mode 100644 index 0000000000..5af4085c03 --- /dev/null +++ b/testsuite/tests/dynlibs/T13702.hs @@ -0,0 +1,9 @@ +{-# LANGUAGE ForeignFunctionInterface #-} + +main :: IO () +main = putStrLn "hello world" + +foreign export ccall "hello" hello :: IO () + +hello :: IO () +hello = putStrLn "hello world again" diff --git a/testsuite/tests/dynlibs/T13702.stdout b/testsuite/tests/dynlibs/T13702.stdout new file mode 100644 index 0000000000..a2b2a712d0 --- /dev/null +++ b/testsuite/tests/dynlibs/T13702.stdout @@ -0,0 +1,2 @@ +hello world +hello world again diff --git a/testsuite/tests/dynlibs/T13702a.hs b/testsuite/tests/dynlibs/T13702a.hs new file mode 100644 index 0000000000..5078852f6e --- /dev/null +++ b/testsuite/tests/dynlibs/T13702a.hs @@ -0,0 +1,12 @@ +{-# LANGUAGE ForeignFunctionInterface #-} + +import Foreign +import System.Posix.DynamicLinker + +main :: IO () +main = do + dl <- dlopen "./T13702" [RTLD_NOW] + funptr <- dlsym dl "hello" :: IO (FunPtr (IO ())) + mkAction funptr + +foreign import ccall "dynamic" mkAction :: FunPtr (IO ()) -> IO () diff --git a/testsuite/tests/dynlibs/all.T b/testsuite/tests/dynlibs/all.T index 0713fe491e..88ce37f445 100644 --- a/testsuite/tests/dynlibs/all.T +++ b/testsuite/tests/dynlibs/all.T @@ -7,3 +7,7 @@ test('T4464', [req_shared_libs, unless(opsys('mingw32'), skip)], run_command, test('T5373', [req_shared_libs], run_command, ['$MAKE --no-print-directory -s T5373']) + +# It's not clear exactly what platforms we can expect this to succeed on. +test('T13702', unless(opsys('linux'), skip), run_command, + ['$MAKE --no-print-directory -s T13702']) diff --git a/testsuite/tests/eyeball/inline2.hs b/testsuite/tests/eyeball/inline2.hs index ec9b65644a..e77e815414 100644 --- a/testsuite/tests/eyeball/inline2.hs +++ b/testsuite/tests/eyeball/inline2.hs @@ -35,6 +35,6 @@ The reason was this: i = I# x Being an unboxed value, we were treating the argument context of x -as intersting, and hence inlining x in the arg of I#. But then we just +as interesting, and hence inlining x in the arg of I#. But then we just float it out again, giving an infinite loop. -} diff --git a/testsuite/tests/ffi/should_compile/T14125.hs b/testsuite/tests/ffi/should_compile/T14125.hs new file mode 100644 index 0000000000..daf236d5ca --- /dev/null +++ b/testsuite/tests/ffi/should_compile/T14125.hs @@ -0,0 +1,17 @@ +{-# LANGUAGE ForeignFunctionInterface #-} +{-# LANGUAGE TypeFamilies #-} +module T14125 where + +import Foreign.C.String +import Foreign.C.Types + +data UnixReturn + +data family IOErrno a +newtype instance IOErrno UnixReturn = UnixErrno CInt + +foreign import ccall unsafe "string.h" + strerror :: IOErrno UnixReturn -> IO CString + +foreign import ccall unsafe "HsBase.h __hscore_get_errno" + get_errno :: IO (IOErrno UnixReturn) diff --git a/testsuite/tests/ffi/should_compile/all.T b/testsuite/tests/ffi/should_compile/all.T index 18192d49ff..0f2f3901c4 100644 --- a/testsuite/tests/ffi/should_compile/all.T +++ b/testsuite/tests/ffi/should_compile/all.T @@ -31,3 +31,4 @@ test('cc015', normal, compile, ['']) test('cc016', normal, compile, ['']) test('T10460', normal, compile, ['']) test('T11983', [omit_ways(['ghci'])], compile, ['T11983.c']) +test('T14125', normal, compile, ['']) diff --git a/testsuite/tests/ffi/should_fail/all.T b/testsuite/tests/ffi/should_fail/all.T index 944f172c02..3bd7b5d909 100644 --- a/testsuite/tests/ffi/should_fail/all.T +++ b/testsuite/tests/ffi/should_fail/all.T @@ -14,8 +14,11 @@ test('T5664', normal, compile_fail, ['-v0']) test('T7506', normal, compile_fail, ['']) test('T7243', normal, compile_fail, ['']) test('T10461', normal, compile_fail, ['']) -test('UnsafeReenter', [omit_ways(['ghciext', 'ghci']), exit_code(1)], compile_and_run, ['-v0 UnsafeReenterC.c']) -test('UnsafeReenterGhci', - [exit_code(1), extra_files(['UnsafeReenter.hs', 'UnsafeReenterC.c']), expect_broken(13730)], - run_command, - ['$MAKE -s --no-print-directory UnsafeReenterGhci']) + +# UnsafeReenter tests implementation of an undefined behavior (calling Haskell +# from an unsafe foreign function) and only makes sense in non-threaded way +# (threaded runtime will hang). See #14912. +test('UnsafeReenter', + [omit_ways(threaded_ways), exit_code(1)], + compile_and_run, + ['UnsafeReenterC.c']) diff --git a/testsuite/tests/ffi/should_run/T9274.hs b/testsuite/tests/ffi/should_run/T9274.hs new file mode 100644 index 0000000000..814deff093 --- /dev/null +++ b/testsuite/tests/ffi/should_run/T9274.hs @@ -0,0 +1,24 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE CApiFFI #-} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE UnliftedFFITypes #-} + +module Main where + +import qualified Data.ByteString.Short.Internal as SBS +import Foreign.C.Types +import GHC.Exts + +foreign import capi unsafe "string.h strlen" + c_strlen_capi :: ByteArray# -> IO CSize + +foreign import capi unsafe "string.h memset" + c_memset_capi :: MutableByteArray# s -> CInt -> CSize -> IO () + +main :: IO () +main = do + n <- c_strlen_capi ba# + print (n == 13) + where + !(SBS.SBS ba#) = "Hello FFI!!!!\NUL" diff --git a/testsuite/tests/dph/smvm/dph-smvm-vseg.stdout b/testsuite/tests/ffi/should_run/T9274.stdout index 0ca95142bb..0ca95142bb 100644 --- a/testsuite/tests/dph/smvm/dph-smvm-vseg.stdout +++ b/testsuite/tests/ffi/should_run/T9274.stdout diff --git a/testsuite/tests/ffi/should_run/all.T b/testsuite/tests/ffi/should_run/all.T index 1bb58c5e49..fd0af7ebc3 100644 --- a/testsuite/tests/ffi/should_run/all.T +++ b/testsuite/tests/ffi/should_run/all.T @@ -174,6 +174,8 @@ test('T4012', [expect_broken_for(7388, ['ghci'])], multimod_compile_and_run, test('T8083', [omit_ways(['ghci'])], compile_and_run, ['T8083_c.c']) +test('T9274', [omit_ways(['ghci'])], compile_and_run, ['']) + test('ffi023', [ omit_ways(['ghci']), extra_clean(['ffi023_c.o']), extra_run_opts('1000 4'), diff --git a/testsuite/tests/gadt/T12087.hs b/testsuite/tests/gadt/T12087.hs new file mode 100644 index 0000000000..e56240c2a4 --- /dev/null +++ b/testsuite/tests/gadt/T12087.hs @@ -0,0 +1,18 @@ +{-# LANGUAGE GADTs #-} +{-# LANGUAGE RankNTypes #-} +module T12087 where + +data F1 a where + MkF1 :: Ord a => Eq a => a -> F1 a + +data F2 a where + MkF2 :: Ord a => a -> Eq a => F2 a + +data F3 a where + MkF3 :: forall a. Eq a => a -> forall b. Eq b => b -> F3 a + +data F4 a where + MkF4 :: forall a b. Eq a => a -> Eq b => b -> F4 a + +data F5 a where + MkF5 :: Int -> Int -> forall a. a -> Int -> Int -> forall b. b -> F5 a diff --git a/testsuite/tests/gadt/T12087.stderr b/testsuite/tests/gadt/T12087.stderr new file mode 100644 index 0000000000..03f2465c7a --- /dev/null +++ b/testsuite/tests/gadt/T12087.stderr @@ -0,0 +1,35 @@ + +T12087.hs:6:3: error: + • GADT constructor type signature cannot contain nested ‘forall’s or contexts + Suggestion: instead use this type signature: + MkF1 :: forall a. (Ord a, Eq a) => a -> F1 a + • In the definition of data constructor ‘MkF1’ + In the data type declaration for ‘F1’ + +T12087.hs:9:3: error: + • GADT constructor type signature cannot contain nested ‘forall’s or contexts + Suggestion: instead use this type signature: + MkF2 :: forall a. (Ord a, Eq a) => F2 a + • In the definition of data constructor ‘MkF2’ + In the data type declaration for ‘F2’ + +T12087.hs:12:3: error: + • GADT constructor type signature cannot contain nested ‘forall’s or contexts + Suggestion: instead use this type signature: + MkF3 :: forall a b. (Eq a, Eq b) => b -> F3 a + • In the definition of data constructor ‘MkF3’ + In the data type declaration for ‘F3’ + +T12087.hs:15:3: error: + • GADT constructor type signature cannot contain nested ‘forall’s or contexts + Suggestion: instead use this type signature: + MkF4 :: forall a b. (Eq a, Eq b) => b -> F4 a + • In the definition of data constructor ‘MkF4’ + In the data type declaration for ‘F4’ + +T12087.hs:18:3: error: + • GADT constructor type signature cannot contain nested ‘forall’s or contexts + Suggestion: instead use this type signature: + MkF5 :: forall a b. a -> Int -> Int -> b -> F5 a + • In the definition of data constructor ‘MkF5’ + In the data type declaration for ‘F5’ diff --git a/testsuite/tests/gadt/T12468.stderr b/testsuite/tests/gadt/T12468.stderr index 729b5c45b0..402a93d82d 100644 --- a/testsuite/tests/gadt/T12468.stderr +++ b/testsuite/tests/gadt/T12468.stderr @@ -4,3 +4,13 @@ T12468.hs:9:7: error: • In the expression: _ In an equation for ‘f’: f I = _ • Relevant bindings include f :: T a -> a (bound at T12468.hs:9:1) + Constraints include a ~ Int (from T12468.hs:9:3) + Valid hole fits include + maxBound :: forall a. Bounded a => a + with maxBound @Int + (imported from ‘Prelude’ at T12468.hs:3:8-13 + (and originally defined in ‘GHC.Enum’)) + minBound :: forall a. Bounded a => a + with minBound @Int + (imported from ‘Prelude’ at T12468.hs:3:8-13 + (and originally defined in ‘GHC.Enum’)) diff --git a/testsuite/tests/gadt/T14320.hs b/testsuite/tests/gadt/T14320.hs new file mode 100644 index 0000000000..4acd4c8f63 --- /dev/null +++ b/testsuite/tests/gadt/T14320.hs @@ -0,0 +1,15 @@ +{-# LANGUAGE RankNTypes, GADTs, KindSignatures #-} +module T14320 +where + +data Exp :: * where + Lit :: (Int -> Exp) + +newtype TypedExp :: * -> * where + TEGood :: forall a . (Exp -> (TypedExp a)) + +-- The only difference here is that the type is wrapped in parentheses, +-- but GHC 8.0.1 rejects this program +-- +newtype TypedExpToo :: * -> * where + TEBad :: (forall a . (Exp -> (TypedExpToo a))) diff --git a/testsuite/tests/gadt/T14719.hs b/testsuite/tests/gadt/T14719.hs new file mode 100644 index 0000000000..004116dcc6 --- /dev/null +++ b/testsuite/tests/gadt/T14719.hs @@ -0,0 +1,8 @@ +{-# LANGUAGE GADTs #-} +module T14719 where + +data Foo1 where + MkFoo1 :: Bool + +newtype Foo2 where + MkFoo2 :: Foo2 diff --git a/testsuite/tests/gadt/T14719.stderr b/testsuite/tests/gadt/T14719.stderr new file mode 100644 index 0000000000..cfac00c0c0 --- /dev/null +++ b/testsuite/tests/gadt/T14719.stderr @@ -0,0 +1,18 @@ + +T14719.hs:5:3: error: + • Data constructor ‘MkFoo1’ returns type ‘Bool’ + instead of an instance of its parent type ‘Foo1’ + • In the definition of data constructor ‘MkFoo1’ + In the data type declaration for ‘Foo1’ + | +5 | MkFoo1 :: Bool + | ^^^^^^^^^^^^^^ + +T14719.hs:8:3: error: + • The constructor of a newtype must have exactly one field + but ‘MkFoo2’ has none + • In the definition of data constructor ‘MkFoo2’ + In the newtype declaration for ‘Foo2’ + | +8 | MkFoo2 :: Foo2 + | ^^^^^^^^^^^^^^ diff --git a/testsuite/tests/gadt/T14808.hs b/testsuite/tests/gadt/T14808.hs new file mode 100644 index 0000000000..da3d5212cd --- /dev/null +++ b/testsuite/tests/gadt/T14808.hs @@ -0,0 +1,18 @@ +{-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE TypeApplications #-} +module T14808 where + +import Data.Kind + +data ECC ctx f a where + ECC :: ctx => f a -> ECC ctx f a + +f :: [()] -> ECC () [] () +f = ECC @() @[] @() + +data ECC2 f a ctx where + ECC2 :: ctx => f a -> ECC2 f a ctx + +f2 :: [()] -> ECC2 [] () () +f2 = ECC2 @() @[] @() diff --git a/testsuite/tests/gadt/T15009.hs b/testsuite/tests/gadt/T15009.hs new file mode 100644 index 0000000000..58e17af864 --- /dev/null +++ b/testsuite/tests/gadt/T15009.hs @@ -0,0 +1,20 @@ +{-# LANGUAGE GADTs #-} + +module T15009 where + +-- T2 is an ordinary H98 data type, +-- and f2 should typecheck with no problem +data T2 a where + MkT2 :: a -> T2 a + +f2 (MkT2 x) = not x + +-- T1 is a GADT, but the equality is really just a 'let' +-- so f1 should also typecheck no problem +data T1 a where + MkT1 :: b ~ a => b -> T1 a + +f1 (MkT1 x) = not x + + + diff --git a/testsuite/tests/gadt/T15558.hs b/testsuite/tests/gadt/T15558.hs new file mode 100644 index 0000000000..91dff3f956 --- /dev/null +++ b/testsuite/tests/gadt/T15558.hs @@ -0,0 +1,14 @@ +{-# LANGUAGE GADTs #-} +{-# LANGUAGE RankNTypes #-} +module T15558 where + +data T a where + MkT :: T Int + +data Foo a = MkFoo ((a ~ Bool) => ()) + +f :: T a -> Foo a +f MkT = MkFoo () + +-- g :: Foo Int +-- g = f MkT diff --git a/testsuite/tests/gadt/T15558.stderr b/testsuite/tests/gadt/T15558.stderr new file mode 100644 index 0000000000..ee70f0373b --- /dev/null +++ b/testsuite/tests/gadt/T15558.stderr @@ -0,0 +1,9 @@ + +T15558.hs:11:15: warning: [-Winaccessible-code (in -Wdefault)] + • Couldn't match type ‘Int’ with ‘Bool’ + Inaccessible code in + a type expected by the context: + (a ~ Bool) => () + • In the first argument of ‘MkFoo’, namely ‘()’ + In the expression: MkFoo () + In an equation for ‘f’: f MkT = MkFoo () diff --git a/testsuite/tests/gadt/T3651.stderr b/testsuite/tests/gadt/T3651.stderr index 14216eb149..62e3bf16d7 100644 --- a/testsuite/tests/gadt/T3651.stderr +++ b/testsuite/tests/gadt/T3651.stderr @@ -1,21 +1,14 @@ -T3651.hs:11:11: error: - • Couldn't match type ‘Bool’ with ‘()’ - Inaccessible code in - a pattern with constructor: U :: Z (), in an equation for ‘unsafe1’ - • In the pattern: U +T3651.hs:11:15: error: + • Couldn't match type ‘()’ with ‘Bool’ + Expected type: a + Actual type: () + • In the expression: () In an equation for ‘unsafe1’: unsafe1 B U = () -T3651.hs:14:11: error: - • Couldn't match type ‘Bool’ with ‘()’ - Inaccessible code in - a pattern with constructor: U :: Z (), in an equation for ‘unsafe2’ - • In the pattern: U +T3651.hs:14:15: error: + • Couldn't match type ‘()’ with ‘Bool’ + Expected type: a + Actual type: () + • In the expression: () In an equation for ‘unsafe2’: unsafe2 B U = () - -T3651.hs:17:11: error: - • Couldn't match type ‘Bool’ with ‘()’ - Inaccessible code in - a pattern with constructor: U :: Z (), in an equation for ‘unsafe3’ - • In the pattern: U - In an equation for ‘unsafe3’: unsafe3 B U = True diff --git a/testsuite/tests/gadt/T7293.hs b/testsuite/tests/gadt/T7293.hs index 26d9188f81..ed82f2a35b 100644 --- a/testsuite/tests/gadt/T7293.hs +++ b/testsuite/tests/gadt/T7293.hs @@ -3,9 +3,11 @@ module T7294 where +import Data.Kind (Type) + data Nat = Zero | Succ Nat -data Vec :: * -> Nat -> * where +data Vec :: Type -> Nat -> Type where Nil :: Vec a Zero Cons :: a -> Vec a n -> Vec a (Succ n) @@ -14,7 +16,7 @@ type instance m :< Zero = False type instance Zero :< Succ n = True type instance Succ n :< Succ m = n :< m -data SNat :: Nat -> * where +data SNat :: Nat -> Type where SZero :: SNat Zero SSucc :: forall (n :: Nat). SNat n -> SNat (Succ n) diff --git a/testsuite/tests/gadt/T7293.stderr b/testsuite/tests/gadt/T7293.stderr index 40b8a04333..87856d4009 100644 --- a/testsuite/tests/gadt/T7293.stderr +++ b/testsuite/tests/gadt/T7293.stderr @@ -1,5 +1,9 @@ -T7293.hs:24:5: error: +T7293.hs:26:1: error: [-Woverlapping-patterns (in -Wdefault), -Werror=overlapping-patterns] + Pattern match is redundant + In an equation for ‘nth’: nth Nil _ = ... + +T7293.hs:26:5: error: [-Winaccessible-code (in -Wdefault), -Werror=inaccessible-code] • Couldn't match type ‘'True’ with ‘'False’ Inaccessible code in a pattern with constructor: Nil :: forall a. Vec a 'Zero, diff --git a/testsuite/tests/gadt/T7294.hs b/testsuite/tests/gadt/T7294.hs index 1c39a2a574..d7615955a7 100644 --- a/testsuite/tests/gadt/T7294.hs +++ b/testsuite/tests/gadt/T7294.hs @@ -4,9 +4,11 @@ module T7294 where +import Data.Kind (Type) + data Nat = Zero | Succ Nat -data Vec :: * -> Nat -> * where +data Vec :: Type -> Nat -> Type where Nil :: Vec a Zero Cons :: a -> Vec a n -> Vec a (Succ n) @@ -15,7 +17,7 @@ type instance m :< Zero = False type instance Zero :< Succ n = True type instance Succ n :< Succ m = n :< m -data SNat :: Nat -> * where +data SNat :: Nat -> Type where SZero :: SNat Zero SSucc :: forall (n :: Nat). SNat n -> SNat (Succ n) diff --git a/testsuite/tests/gadt/T7294.stderr b/testsuite/tests/gadt/T7294.stderr index 2782b8a1f2..d7b53ee9e2 100644 --- a/testsuite/tests/gadt/T7294.stderr +++ b/testsuite/tests/gadt/T7294.stderr @@ -1,9 +1,9 @@ -T7294.hs:25:1: warning: [-Woverlapping-patterns (in -Wdefault)] +T7294.hs:27:1: warning: [-Woverlapping-patterns (in -Wdefault)] Pattern match is redundant In an equation for ‘nth’: nth Nil _ = ... -T7294.hs:25:5: warning: [-Wdeferred-type-errors (in -Wdefault)] +T7294.hs:27:5: warning: [-Winaccessible-code (in -Wdefault)] • Couldn't match type ‘'True’ with ‘'False’ Inaccessible code in a pattern with constructor: Nil :: forall a. Vec a 'Zero, diff --git a/testsuite/tests/gadt/T7558.stderr b/testsuite/tests/gadt/T7558.stderr index f3d74362a5..29d7fa65a3 100644 --- a/testsuite/tests/gadt/T7558.stderr +++ b/testsuite/tests/gadt/T7558.stderr @@ -1,11 +1,10 @@ -T7558.hs:8:4: error: +T7558.hs:8:18: error: • Occurs check: cannot construct the infinite type: a ~ Maybe a - Inaccessible code in - a pattern with constructor: - MkT :: forall a b. (a ~ Maybe b) => a -> Maybe b -> T a b, - in an equation for ‘f’ - • In the pattern: MkT x y - In an equation for ‘f’: f (MkT x y) = [x, y] `seq` True + • In the expression: y + In the first argument of ‘seq’, namely ‘[x, y]’ + In the expression: [x, y] `seq` True • Relevant bindings include + y :: Maybe a (bound at T7558.hs:8:10) + x :: a (bound at T7558.hs:8:8) f :: T a a -> Bool (bound at T7558.hs:8:1) diff --git a/testsuite/tests/gadt/all.T b/testsuite/tests/gadt/all.T index 877943b0c5..395cce8c12 100644 --- a/testsuite/tests/gadt/all.T +++ b/testsuite/tests/gadt/all.T @@ -56,7 +56,7 @@ test('records-fail1', normal, compile_fail, ['']) test('doaitse', normal, compile, ['']) test('josef', normal, compile, ['']) -# Interaction of fundeps with GADTs doesn't work well +# Interaction of fundeps with GADTs doesn't work well test('gadt-fd', expect_broken(345), compile, ['']) test('karl1', normal, compile, ['']) @@ -105,11 +105,17 @@ test('T5424', [], multimod_compile, ['T5424', '-v0 -O0']) test('FloatEq', normal, compile, ['']) test('T7205', normal, compile, ['']) -test('T7293', normal, compile_fail, ['']) +test('T7293', normal, compile_fail, ['-Werror']) test('T7294', normal, compile, ['']) test('T7321', [], run_command, ['$MAKE -s --no-print-directory T7321']) test('T7974', normal, compile, ['']) test('T7558', normal, compile_fail, ['']) test('T9096', normal, compile, ['']) test('T9380', normal, compile_and_run, ['']) +test('T12087', normal, compile_fail, ['']) test('T12468', normal, compile_fail, ['']) +test('T14320', normal, compile, ['']) +test('T14719', normal, compile_fail, ['-fdiagnostics-show-caret']) +test('T14808', normal, compile, ['']) +test('T15009', normal, compile, ['']) +test('T15558', normal, compile, ['']) diff --git a/testsuite/tests/gadt/gadt7.stderr b/testsuite/tests/gadt/gadt7.stderr index ea9033ac6c..bb179975fb 100644 --- a/testsuite/tests/gadt/gadt7.stderr +++ b/testsuite/tests/gadt/gadt7.stderr @@ -1,15 +1,15 @@ gadt7.hs:16:38: error: • Couldn't match expected type ‘p1’ with actual type ‘p’ - ‘p1’ is untouchable + ‘p’ is untouchable inside the constraints: a ~ Int bound by a pattern with constructor: K :: T Int, in a case alternative at gadt7.hs:16:33 - ‘p1’ is a rigid type variable bound by - the inferred type of i1b :: T a -> p -> p1 at gadt7.hs:16:1-44 ‘p’ is a rigid type variable bound by the inferred type of i1b :: T a -> p -> p1 at gadt7.hs:16:1-44 + ‘p1’ is a rigid type variable bound by + the inferred type of i1b :: T a -> p -> p1 at gadt7.hs:16:1-44 Possible fix: add a type signature for ‘i1b’ • In the expression: y1 In a case alternative: K -> y1 diff --git a/testsuite/tests/gadt/gadtSyntaxFail001.stderr b/testsuite/tests/gadt/gadtSyntaxFail001.stderr index 248bc98044..9e3c0d4ffc 100644 --- a/testsuite/tests/gadt/gadtSyntaxFail001.stderr +++ b/testsuite/tests/gadt/gadtSyntaxFail001.stderr @@ -2,6 +2,6 @@ gadtSyntaxFail001.hs:8:5: error: • Data constructor ‘C2’ has existential type variables, a context, or a specialised result type C2 :: forall a. a -> Char -> Foo a Int - (Use ExistentialQuantification or GADTs to allow this) + (Enable ExistentialQuantification or GADTs to allow this) • In the definition of data constructor ‘C2’ In the data type declaration for ‘Foo’ diff --git a/testsuite/tests/gadt/gadtSyntaxFail002.stderr b/testsuite/tests/gadt/gadtSyntaxFail002.stderr index 7c30b794f9..7b0251c7e1 100644 --- a/testsuite/tests/gadt/gadtSyntaxFail002.stderr +++ b/testsuite/tests/gadt/gadtSyntaxFail002.stderr @@ -2,6 +2,6 @@ gadtSyntaxFail002.hs:8:5: error: • Data constructor ‘C2’ has existential type variables, a context, or a specialised result type C2 :: forall a. a -> Char -> Foo a a - (Use ExistentialQuantification or GADTs to allow this) + (Enable ExistentialQuantification or GADTs to allow this) • In the definition of data constructor ‘C2’ In the data type declaration for ‘Foo’ diff --git a/testsuite/tests/gadt/gadtSyntaxFail003.stderr b/testsuite/tests/gadt/gadtSyntaxFail003.stderr index bb2b6a2fff..903624499a 100644 --- a/testsuite/tests/gadt/gadtSyntaxFail003.stderr +++ b/testsuite/tests/gadt/gadtSyntaxFail003.stderr @@ -1,7 +1,7 @@ gadtSyntaxFail003.hs:7:5: error: • Data constructor ‘C1’ has existential type variables, a context, or a specialised result type - C1 :: forall b a c. a -> Int -> c -> Foo b a - (Use ExistentialQuantification or GADTs to allow this) + C1 :: forall a c b. a -> Int -> c -> Foo b a + (Enable ExistentialQuantification or GADTs to allow this) • In the definition of data constructor ‘C1’ In the data type declaration for ‘Foo’ diff --git a/testsuite/tests/generics/GEq/GEq1.hs b/testsuite/tests/generics/GEq/GEq1.hs index 54867db8ed..1c7e2ca8c3 100644 --- a/testsuite/tests/generics/GEq/GEq1.hs +++ b/testsuite/tests/generics/GEq/GEq1.hs @@ -3,6 +3,7 @@ module Main where +import Data.Kind import GHC.Exts import GHC.Generics hiding (C, D) import GEq1A @@ -18,14 +19,14 @@ data D a = D0 | D1 { d11 :: a, d12 :: (D a) } data (:**:) a b = a :**: b deriving Generic -data family F a b :: * -> * +data family F a b :: Type -> Type data instance F Int b c = F b Int c deriving Generic data U a = U a Addr# Char# Double# Float# Int# Word# deriving Generic -data family UF a b :: * -> * +data family UF a b :: Type -> Type data instance UF Int b c = UF b c Addr# Char# Double# Float# Int# Word# deriving Generic diff --git a/testsuite/tests/generics/GenDerivOutput.stderr b/testsuite/tests/generics/GenDerivOutput.stderr index d531e914f4..9c008e0038 100644 --- a/testsuite/tests/generics/GenDerivOutput.stderr +++ b/testsuite/tests/generics/GenDerivOutput.stderr @@ -116,7 +116,7 @@ Derived type family instances: 'GHC.Types.True) (GHC.Generics.S1 ('GHC.Generics.MetaSel - ('GHC.Base.Just + ('GHC.Maybe.Just "element") 'GHC.Generics.NoSourceUnpackedness 'GHC.Generics.NoSourceStrictness @@ -124,7 +124,7 @@ Derived type family instances: (GHC.Generics.Rec0 a) GHC.Generics.:*: GHC.Generics.S1 ('GHC.Generics.MetaSel - ('GHC.Base.Just + ('GHC.Maybe.Just "rest") 'GHC.Generics.NoSourceUnpackedness 'GHC.Generics.NoSourceStrictness @@ -146,7 +146,7 @@ Derived type family instances: 'GHC.Types.True) (GHC.Generics.S1 ('GHC.Generics.MetaSel - ('GHC.Base.Just + ('GHC.Maybe.Just "element") 'GHC.Generics.NoSourceUnpackedness 'GHC.Generics.NoSourceStrictness @@ -154,7 +154,7 @@ Derived type family instances: GHC.Generics.Par1 GHC.Generics.:*: GHC.Generics.S1 ('GHC.Generics.MetaSel - ('GHC.Base.Just + ('GHC.Maybe.Just "rest") 'GHC.Generics.NoSourceUnpackedness 'GHC.Generics.NoSourceStrictness @@ -180,14 +180,14 @@ Derived type family instances: 'GHC.Types.False) (GHC.Generics.S1 ('GHC.Generics.MetaSel - 'GHC.Base.Nothing + 'GHC.Maybe.Nothing 'GHC.Generics.NoSourceUnpackedness 'GHC.Generics.NoSourceStrictness 'GHC.Generics.DecidedLazy) (GHC.Generics.Rec0 a) GHC.Generics.:*: GHC.Generics.S1 ('GHC.Generics.MetaSel - 'GHC.Base.Nothing + 'GHC.Maybe.Nothing 'GHC.Generics.NoSourceUnpackedness 'GHC.Generics.NoSourceStrictness 'GHC.Generics.DecidedLazy) @@ -211,14 +211,14 @@ Derived type family instances: 'GHC.Types.False) (GHC.Generics.S1 ('GHC.Generics.MetaSel - 'GHC.Base.Nothing + 'GHC.Maybe.Nothing 'GHC.Generics.NoSourceUnpackedness 'GHC.Generics.NoSourceStrictness 'GHC.Generics.DecidedLazy) GHC.Generics.Par1 GHC.Generics.:*: GHC.Generics.S1 ('GHC.Generics.MetaSel - 'GHC.Base.Nothing + 'GHC.Maybe.Nothing 'GHC.Generics.NoSourceUnpackedness 'GHC.Generics.NoSourceStrictness 'GHC.Generics.DecidedLazy) diff --git a/testsuite/tests/generics/GenDerivOutput1_0.stderr b/testsuite/tests/generics/GenDerivOutput1_0.stderr index bf9cf1590c..6090499abf 100644 --- a/testsuite/tests/generics/GenDerivOutput1_0.stderr +++ b/testsuite/tests/generics/GenDerivOutput1_0.stderr @@ -43,7 +43,7 @@ Derived type family instances: 'GHC.Types.True) (GHC.Generics.S1 ('GHC.Generics.MetaSel - ('GHC.Base.Just + ('GHC.Maybe.Just "element") 'GHC.Generics.NoSourceUnpackedness 'GHC.Generics.NoSourceStrictness @@ -51,7 +51,7 @@ Derived type family instances: GHC.Generics.Par1 GHC.Generics.:*: GHC.Generics.S1 ('GHC.Generics.MetaSel - ('GHC.Base.Just + ('GHC.Maybe.Just "rest") 'GHC.Generics.NoSourceUnpackedness 'GHC.Generics.NoSourceStrictness diff --git a/testsuite/tests/generics/GenDerivOutput1_1.stderr b/testsuite/tests/generics/GenDerivOutput1_1.stderr index 5f4e7e241d..139d7ed255 100644 --- a/testsuite/tests/generics/GenDerivOutput1_1.stderr +++ b/testsuite/tests/generics/GenDerivOutput1_1.stderr @@ -178,14 +178,14 @@ Derived type family instances: 'GHC.Types.True) (GHC.Generics.S1 ('GHC.Generics.MetaSel - ('GHC.Base.Just "d11d") + ('GHC.Maybe.Just "d11d") 'GHC.Generics.NoSourceUnpackedness 'GHC.Generics.NoSourceStrictness 'GHC.Generics.DecidedLazy) GHC.Generics.Par1 GHC.Generics.:*: GHC.Generics.S1 ('GHC.Generics.MetaSel - ('GHC.Base.Just + ('GHC.Maybe.Just "d12d") 'GHC.Generics.NoSourceUnpackedness 'GHC.Generics.NoSourceStrictness @@ -206,14 +206,14 @@ Derived type family instances: 'GHC.Types.True) (GHC.Generics.S1 ('GHC.Generics.MetaSel - ('GHC.Base.Just "d11d") + ('GHC.Maybe.Just "d11d") 'GHC.Generics.NoSourceUnpackedness 'GHC.Generics.NoSourceStrictness 'GHC.Generics.DecidedLazy) (GHC.Generics.Rec0 a) GHC.Generics.:*: GHC.Generics.S1 ('GHC.Generics.MetaSel - ('GHC.Base.Just + ('GHC.Maybe.Just "d12d") 'GHC.Generics.NoSourceUnpackedness 'GHC.Generics.NoSourceStrictness @@ -235,14 +235,14 @@ Derived type family instances: 'GHC.Types.True) (GHC.Generics.S1 ('GHC.Generics.MetaSel - ('GHC.Base.Just "d11c") + ('GHC.Maybe.Just "d11c") 'GHC.Generics.NoSourceUnpackedness 'GHC.Generics.NoSourceStrictness 'GHC.Generics.DecidedLazy) (GHC.Generics.Rec0 a) GHC.Generics.:*: GHC.Generics.S1 ('GHC.Generics.MetaSel - ('GHC.Base.Just + ('GHC.Maybe.Just "d12c") 'GHC.Generics.NoSourceUnpackedness 'GHC.Generics.NoSourceStrictness @@ -264,14 +264,14 @@ Derived type family instances: 'GHC.Types.True) (GHC.Generics.S1 ('GHC.Generics.MetaSel - ('GHC.Base.Just "d11b") + ('GHC.Maybe.Just "d11b") 'GHC.Generics.NoSourceUnpackedness 'GHC.Generics.NoSourceStrictness 'GHC.Generics.DecidedLazy) GHC.Generics.Par1 GHC.Generics.:*: GHC.Generics.S1 ('GHC.Generics.MetaSel - ('GHC.Base.Just + ('GHC.Maybe.Just "d12b") 'GHC.Generics.NoSourceUnpackedness 'GHC.Generics.NoSourceStrictness @@ -292,14 +292,14 @@ Derived type family instances: 'GHC.Types.True) (GHC.Generics.S1 ('GHC.Generics.MetaSel - ('GHC.Base.Just "d11a") + ('GHC.Maybe.Just "d11a") 'GHC.Generics.NoSourceUnpackedness 'GHC.Generics.NoSourceStrictness 'GHC.Generics.DecidedLazy) (GHC.Generics.Rec0 a) GHC.Generics.:*: GHC.Generics.S1 ('GHC.Generics.MetaSel - ('GHC.Base.Just + ('GHC.Maybe.Just "d12a") 'GHC.Generics.NoSourceUnpackedness 'GHC.Generics.NoSourceStrictness @@ -321,14 +321,14 @@ Derived type family instances: 'GHC.Types.True) (GHC.Generics.S1 ('GHC.Generics.MetaSel - ('GHC.Base.Just "d11a") + ('GHC.Maybe.Just "d11a") 'GHC.Generics.NoSourceUnpackedness 'GHC.Generics.NoSourceStrictness 'GHC.Generics.DecidedLazy) GHC.Generics.Par1 GHC.Generics.:*: GHC.Generics.S1 ('GHC.Generics.MetaSel - ('GHC.Base.Just + ('GHC.Maybe.Just "d12a") 'GHC.Generics.NoSourceUnpackedness 'GHC.Generics.NoSourceStrictness @@ -349,14 +349,14 @@ Derived type family instances: 'GHC.Types.True) (GHC.Generics.S1 ('GHC.Generics.MetaSel - ('GHC.Base.Just "d11b") + ('GHC.Maybe.Just "d11b") 'GHC.Generics.NoSourceUnpackedness 'GHC.Generics.NoSourceStrictness 'GHC.Generics.DecidedLazy) (GHC.Generics.Rec0 a) GHC.Generics.:*: GHC.Generics.S1 ('GHC.Generics.MetaSel - ('GHC.Base.Just + ('GHC.Maybe.Just "d12b") 'GHC.Generics.NoSourceUnpackedness 'GHC.Generics.NoSourceStrictness @@ -378,14 +378,14 @@ Derived type family instances: 'GHC.Types.True) (GHC.Generics.S1 ('GHC.Generics.MetaSel - ('GHC.Base.Just "d11c") + ('GHC.Maybe.Just "d11c") 'GHC.Generics.NoSourceUnpackedness 'GHC.Generics.NoSourceStrictness 'GHC.Generics.DecidedLazy) GHC.Generics.Par1 GHC.Generics.:*: GHC.Generics.S1 ('GHC.Generics.MetaSel - ('GHC.Base.Just + ('GHC.Maybe.Just "d12c") 'GHC.Generics.NoSourceUnpackedness 'GHC.Generics.NoSourceStrictness diff --git a/testsuite/tests/generics/Makefile b/testsuite/tests/generics/Makefile index 9a36a1c5fe..69a5802b96 100644 --- a/testsuite/tests/generics/Makefile +++ b/testsuite/tests/generics/Makefile @@ -1,3 +1,8 @@ TOP=../.. include $(TOP)/mk/boilerplate.mk include $(TOP)/mk/test.mk + +T15012: + $(RM) T15012.hi T15012.o T15012a.hi T15012a.o + '$(TEST_HC)' $(TEST_HC_OPTS) -c T15012a.hs + '$(TEST_HC)' $(TEST_HC_OPTS) -c T15012.hs diff --git a/testsuite/tests/generics/T10604/T10604_deriving.stderr b/testsuite/tests/generics/T10604/T10604_deriving.stderr index 20417e37a5..cb9ea36454 100644 --- a/testsuite/tests/generics/T10604/T10604_deriving.stderr +++ b/testsuite/tests/generics/T10604/T10604_deriving.stderr @@ -232,7 +232,7 @@ Derived type family instances: (GHC.Generics.S1 * ('GHC.Generics.MetaSel - ('GHC.Base.Nothing GHC.Types.Symbol) + ('GHC.Maybe.Nothing GHC.Types.Symbol) 'GHC.Generics.NoSourceUnpackedness 'GHC.Generics.NoSourceStrictness 'GHC.Generics.DecidedLazy) @@ -251,7 +251,7 @@ Derived type family instances: (GHC.Generics.S1 (* -> *) ('GHC.Generics.MetaSel - ('GHC.Base.Nothing GHC.Types.Symbol) + ('GHC.Maybe.Nothing GHC.Types.Symbol) 'GHC.Generics.NoSourceUnpackedness 'GHC.Generics.NoSourceStrictness 'GHC.Generics.DecidedLazy) @@ -273,7 +273,7 @@ Derived type family instances: (GHC.Generics.S1 * ('GHC.Generics.MetaSel - ('GHC.Base.Nothing + ('GHC.Maybe.Nothing GHC.Types.Symbol) 'GHC.Generics.NoSourceUnpackedness 'GHC.Generics.NoSourceStrictness @@ -301,7 +301,7 @@ Derived type family instances: (GHC.Generics.S1 (k -> *) ('GHC.Generics.MetaSel - ('GHC.Base.Nothing GHC.Types.Symbol) + ('GHC.Maybe.Nothing GHC.Types.Symbol) 'GHC.Generics.NoSourceUnpackedness 'GHC.Generics.NoSourceStrictness 'GHC.Generics.DecidedLazy) @@ -333,7 +333,8 @@ Derived type family instances: (GHC.Generics.S1 * ('GHC.Generics.MetaSel - ('GHC.Base.Nothing GHC.Types.Symbol) + ('GHC.Maybe.Nothing + GHC.Types.Symbol) 'GHC.Generics.NoSourceUnpackedness 'GHC.Generics.NoSourceStrictness 'GHC.Generics.DecidedLazy) @@ -342,7 +343,8 @@ Derived type family instances: (GHC.Generics.S1 * ('GHC.Generics.MetaSel - ('GHC.Base.Nothing GHC.Types.Symbol) + ('GHC.Maybe.Nothing + GHC.Types.Symbol) 'GHC.Generics.NoSourceUnpackedness 'GHC.Generics.NoSourceStrictness 'GHC.Generics.DecidedLazy) @@ -359,7 +361,8 @@ Derived type family instances: (GHC.Generics.S1 * ('GHC.Generics.MetaSel - ('GHC.Base.Nothing GHC.Types.Symbol) + ('GHC.Maybe.Nothing + GHC.Types.Symbol) 'GHC.Generics.NoSourceUnpackedness 'GHC.Generics.NoSourceStrictness 'GHC.Generics.DecidedLazy) @@ -368,7 +371,8 @@ Derived type family instances: (GHC.Generics.S1 * ('GHC.Generics.MetaSel - ('GHC.Base.Nothing GHC.Types.Symbol) + ('GHC.Maybe.Nothing + GHC.Types.Symbol) 'GHC.Generics.NoSourceUnpackedness 'GHC.Generics.NoSourceStrictness 'GHC.Generics.DecidedLazy) @@ -395,7 +399,8 @@ Derived type family instances: (GHC.Generics.S1 k ('GHC.Generics.MetaSel - ('GHC.Base.Nothing GHC.Types.Symbol) + ('GHC.Maybe.Nothing + GHC.Types.Symbol) 'GHC.Generics.NoSourceUnpackedness 'GHC.Generics.NoSourceStrictness 'GHC.Generics.DecidedLazy) @@ -404,7 +409,8 @@ Derived type family instances: (GHC.Generics.S1 k ('GHC.Generics.MetaSel - ('GHC.Base.Nothing GHC.Types.Symbol) + ('GHC.Maybe.Nothing + GHC.Types.Symbol) 'GHC.Generics.NoSourceUnpackedness 'GHC.Generics.NoSourceStrictness 'GHC.Generics.DecidedLazy) @@ -421,7 +427,8 @@ Derived type family instances: (GHC.Generics.S1 k ('GHC.Generics.MetaSel - ('GHC.Base.Nothing GHC.Types.Symbol) + ('GHC.Maybe.Nothing + GHC.Types.Symbol) 'GHC.Generics.NoSourceUnpackedness 'GHC.Generics.NoSourceStrictness 'GHC.Generics.DecidedLazy) @@ -430,7 +437,8 @@ Derived type family instances: (GHC.Generics.S1 k ('GHC.Generics.MetaSel - ('GHC.Base.Nothing GHC.Types.Symbol) + ('GHC.Maybe.Nothing + GHC.Types.Symbol) 'GHC.Generics.NoSourceUnpackedness 'GHC.Generics.NoSourceStrictness 'GHC.Generics.DecidedLazy) @@ -454,7 +462,7 @@ Derived type family instances: (GHC.Generics.S1 * ('GHC.Generics.MetaSel - ('GHC.Base.Nothing + ('GHC.Maybe.Nothing GHC.Types.Symbol) 'GHC.Generics.NoSourceUnpackedness 'GHC.Generics.NoSourceStrictness @@ -469,7 +477,7 @@ Derived type family instances: (GHC.Generics.S1 * ('GHC.Generics.MetaSel - ('GHC.Base.Nothing + ('GHC.Maybe.Nothing GHC.Types.Symbol) 'GHC.Generics.NoSourceUnpackedness 'GHC.Generics.NoSourceStrictness @@ -494,7 +502,7 @@ Derived type family instances: (GHC.Generics.S1 * ('GHC.Generics.MetaSel - ('GHC.Base.Nothing + ('GHC.Maybe.Nothing GHC.Types.Symbol) 'GHC.Generics.NoSourceUnpackedness 'GHC.Generics.NoSourceStrictness @@ -509,7 +517,7 @@ Derived type family instances: (GHC.Generics.S1 * ('GHC.Generics.MetaSel - ('GHC.Base.Nothing + ('GHC.Maybe.Nothing GHC.Types.Symbol) 'GHC.Generics.NoSourceUnpackedness 'GHC.Generics.NoSourceStrictness diff --git a/testsuite/tests/generics/T15012.hs b/testsuite/tests/generics/T15012.hs new file mode 100644 index 0000000000..388eddc0ed --- /dev/null +++ b/testsuite/tests/generics/T15012.hs @@ -0,0 +1,7 @@ +module T15012 where + +import GHC.Generics +import T15012a + +blah :: IO () +blah = print $ from1 $ TyFamily 1 2 diff --git a/testsuite/tests/generics/T15012a.hs b/testsuite/tests/generics/T15012a.hs new file mode 100644 index 0000000000..5109ea08f0 --- /dev/null +++ b/testsuite/tests/generics/T15012a.hs @@ -0,0 +1,11 @@ +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE TypeFamilies #-} +module T15012a where + +import GHC.Generics + +type FakeOut a = Int + +data family TyFamily y z +data instance TyFamily a b = TyFamily Int (FakeOut b) + deriving Generic1 diff --git a/testsuite/tests/generics/all.T b/testsuite/tests/generics/all.T index 1d4aeaee38..f127f7895f 100644 --- a/testsuite/tests/generics/all.T +++ b/testsuite/tests/generics/all.T @@ -43,3 +43,5 @@ test('T10361a', normal, compile, ['']) test('T10361b', normal, compile, ['']) test('T11358', normal, compile_and_run, ['']) test('T12220', normal, compile, ['']) +test('T15012', [extra_files(['T15012.hs', 'T15012a.hs'])], run_command, + ['$MAKE -s --no-print-directory T15012']) diff --git a/testsuite/tests/ghc-api/T4891/T4891.hs b/testsuite/tests/ghc-api/T4891/T4891.hs index b2f8cc464d..62edae0e78 100644 --- a/testsuite/tests/ghc-api/T4891/T4891.hs +++ b/testsuite/tests/ghc-api/T4891/T4891.hs @@ -5,8 +5,8 @@ import ByteCodeLink import CoreMonad import Data.Array import DataCon -import DebuggerUtils import GHC +import GHC.Exts.Heap import HscTypes import Linker import RtClosureInspect @@ -50,17 +50,18 @@ chaseConstructor :: (GhcMonad m) => HValue -> m () chaseConstructor !hv = do dflags <- getDynFlags liftIO $ putStrLn "=====" - closure <- liftIO $ getClosureData dflags hv - case tipe closure of - Indirection _ -> chaseConstructor (ptrs closure ! 0) - Constr -> do - withSession $ \hscEnv -> liftIO $ initTcForLookup hscEnv $ do - eDcname <- dataConInfoPtrToName (infoPtr closure) + closure <- liftIO $ getClosureData hv + case closure of + IndClosure{indirectee=ind} -> + (\(Box a) -> chaseConstructor (unsafeCoerce a)) ind + ConstrClosure{} -> do + withSession $ \hscEnv -> liftIO $ do + eDcname <- constrClosToName hscEnv closure case eDcname of Left _ -> return () Right dcName -> do - liftIO $ putStrLn $ "Name: " ++ showPpr dflags dcName - liftIO $ putStrLn $ "OccString: " ++ "'" ++ getOccString dcName ++ "'" - dc <- tcLookupDataCon dcName - liftIO $ putStrLn $ "DataCon: " ++ showPpr dflags dc + putStrLn $ "Name: " ++ showPpr dflags dcName + putStrLn $ "OccString: " ++ "'" ++ getOccString dcName ++ "'" + dc <- ioLookupDataCon hscEnv dcName + putStrLn $ "DataCon: " ++ showPpr dflags dc _ -> return () diff --git a/testsuite/tests/ghc-api/T6145.hs b/testsuite/tests/ghc-api/T6145.hs index fc0a71ade3..3f4afc449e 100644 --- a/testsuite/tests/ghc-api/T6145.hs +++ b/testsuite/tests/ghc-api/T6145.hs @@ -34,10 +34,8 @@ main = do where isDataCon (L _ (AbsBinds { abs_binds = bs })) = not (isEmptyBag (filterBag isDataCon bs)) - isDataCon (L _ (AbsBindsSig { abs_sig_bind = b })) - = isDataCon b isDataCon (L l (f@FunBind {})) - | (MG (L _ (m:_)) _ _ _) <- fun_matches f, + | (MG _ (L _ (m:_)) _) <- fun_matches f, (L _ (c@ConPatOut{}):_)<-hsLMatchPats m, (L l _)<-pat_con c = isGoodSrcSpan l -- Check that the source location is a good one diff --git a/testsuite/tests/ghc-api/T9015.hs b/testsuite/tests/ghc-api/T9015.hs index 6f7efec8d0..977390b88e 100644 --- a/testsuite/tests/ghc-api/T9015.hs +++ b/testsuite/tests/ghc-api/T9015.hs @@ -13,7 +13,6 @@ testStrings = [ , "add a b = a+b" , "data Foo = Foo String" , "deriving instance Show Foo" - , "{-# NOVECTORISE foo #-}" , "{-# WARNING Foo \"Just a warning\" #-}" , "{-# ANN foo (Just \"Hello\") #-}" , "{-# RULES \"map/map\" forall f g xs. map f (map g xs) = map (f.g) xs #-}" diff --git a/testsuite/tests/ghc-api/T9015.stdout b/testsuite/tests/ghc-api/T9015.stdout index 7b9b6e92de..0d0394eb39 100644 --- a/testsuite/tests/ghc-api/T9015.stdout +++ b/testsuite/tests/ghc-api/T9015.stdout @@ -5,7 +5,6 @@ import Data.Maybe (isJust): True add a b = a+b: False data Foo = Foo String: False deriving instance Show Foo: False -{-# NOVECTORISE foo #-}: False {-# WARNING Foo "Just a warning" #-}: False {-# ANN foo (Just "Hello") #-}: False {-# RULES "map/map" forall f g xs. map f (map g xs) = map (f.g) xs #-}: False @@ -34,7 +33,6 @@ import Data.Maybe (isJust): False add a b = a+b: True data Foo = Foo String: True deriving instance Show Foo: True -{-# NOVECTORISE foo #-}: True {-# WARNING Foo "Just a warning" #-}: True {-# ANN foo (Just "Hello") #-}: True {-# RULES "map/map" forall f g xs. map f (map g xs) = map (f.g) xs #-}: True @@ -63,7 +61,6 @@ import Data.Maybe (isJust): False add a b = a+b: False data Foo = Foo String: False deriving instance Show Foo: False -{-# NOVECTORISE foo #-}: False {-# WARNING Foo "Just a warning" #-}: False {-# ANN foo (Just "Hello") #-}: False {-# RULES "map/map" forall f g xs. map f (map g xs) = map (f.g) xs #-}: False @@ -84,3 +81,4 @@ x <- foo y: True a <-: False 2 +: False @#: False + diff --git a/testsuite/tests/ghc-api/annotations/Makefile b/testsuite/tests/ghc-api/annotations/Makefile index 2da5fc00a9..98b45744ce 100644 --- a/testsuite/tests/ghc-api/annotations/Makefile +++ b/testsuite/tests/ghc-api/annotations/Makefile @@ -141,3 +141,7 @@ T12417: .PHONY: T13163 T13163: $(CHECK_API_ANNOTATIONS) "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" Test13163.hs + +.PHONY: T15303 +T15303: + $(CHECK_API_ANNOTATIONS) "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" Test15303.hs diff --git a/testsuite/tests/ghc-api/annotations/T10268.stdout b/testsuite/tests/ghc-api/annotations/T10268.stdout index 78337330cb..399393d653 100644 --- a/testsuite/tests/ghc-api/annotations/T10268.stdout +++ b/testsuite/tests/ghc-api/annotations/T10268.stdout @@ -12,6 +12,7 @@ ((Test10268.hs:5:6-17,AnnThIdSplice), [Test10268.hs:5:6-17]), ((Test10268.hs:7:1-27,AnnDcolon), [Test10268.hs:7:6-7]), ((Test10268.hs:7:1-27,AnnSemi), [Test10268.hs:8:1]), +((Test10268.hs:7:9,AnnRarrow), [Test10268.hs:7:11-12]), ((Test10268.hs:7:9-27,AnnRarrow), [Test10268.hs:7:11-12]), ((Test10268.hs:7:22-25,AnnCloseS), [Test10268.hs:7:25]), ((Test10268.hs:7:22-25,AnnOpenS), [Test10268.hs:7:23]), diff --git a/testsuite/tests/ghc-api/annotations/T10278.stdout b/testsuite/tests/ghc-api/annotations/T10278.stdout index 46767575b1..afac1f6f3d 100644 --- a/testsuite/tests/ghc-api/annotations/T10278.stdout +++ b/testsuite/tests/ghc-api/annotations/T10278.stdout @@ -12,7 +12,9 @@ ((Test10278.hs:4:19-61,AnnForall), [Test10278.hs:4:19-24]), ((Test10278.hs:4:31-61,AnnDot), [Test10278.hs:4:42]), ((Test10278.hs:4:31-61,AnnForall), [Test10278.hs:4:31-36]), +((Test10278.hs:4:44-46,AnnRarrow), [Test10278.hs:4:48-49]), ((Test10278.hs:4:44-61,AnnRarrow), [Test10278.hs:4:48-49]), +((Test10278.hs:4:51-54,AnnRarrow), [Test10278.hs:4:56-57]), ((Test10278.hs:4:51-61,AnnRarrow), [Test10278.hs:4:56-57]), ((Test10278.hs:5:1-26,AnnEqual), [Test10278.hs:5:16]), ((Test10278.hs:5:1-26,AnnFunId), [Test10278.hs:5:1-14]), @@ -25,6 +27,7 @@ ((Test10278.hs:7:21-24,AnnComma), [Test10278.hs:7:25]), ((Test10278.hs:(8,19)-(10,58),AnnCloseP), [Test10278.hs:10:58]), ((Test10278.hs:(8,19)-(10,58),AnnOpenP), [Test10278.hs:8:19]), +((Test10278.hs:(8,19)-(10,58),AnnRarrow), [Test10278.hs:11:23-24]), ((Test10278.hs:(8,19)-(11,33),AnnRarrow), [Test10278.hs:11:23-24]), ((Test10278.hs:(8,20)-(10,57),AnnDot), [Test10278.hs:8:30]), ((Test10278.hs:(8,20)-(10,57),AnnForall), [Test10278.hs:8:20-25]), @@ -36,6 +39,7 @@ ((Test10278.hs:9:38-50,AnnOpenP), [Test10278.hs:9:38]), ((Test10278.hs:10:45-57,AnnCloseP), [Test10278.hs:10:57]), ((Test10278.hs:10:45-57,AnnOpenP), [Test10278.hs:10:45]), +((Test10278.hs:11:26,AnnRarrow), [Test10278.hs:11:28-29]), ((Test10278.hs:11:26-33,AnnRarrow), [Test10278.hs:11:28-29]), ((Test10278.hs:11:31-33,AnnCloseS), [Test10278.hs:11:33]), ((Test10278.hs:11:31-33,AnnOpenS), [Test10278.hs:11:31]), diff --git a/testsuite/tests/ghc-api/annotations/T10312.stdout b/testsuite/tests/ghc-api/annotations/T10312.stdout index c8dff60b10..939a78e478 100644 --- a/testsuite/tests/ghc-api/annotations/T10312.stdout +++ b/testsuite/tests/ghc-api/annotations/T10312.stdout @@ -119,9 +119,9 @@ ((Test10312.hs:48:5-22,AnnComma), [Test10312.hs:49:3]), ((Test10312.hs:48:5-22,AnnDcolon), [Test10312.hs:48:14-15]), ((Test10312.hs:49:5-20,AnnDcolon), [Test10312.hs:49:15-16]), -((Test10312.hs:50:5-23,AnnCloseP), [Test10312.hs:50:23]), ((Test10312.hs:50:5-23,AnnDeriving), [Test10312.hs:50:5-12]), -((Test10312.hs:50:5-23,AnnOpenP), [Test10312.hs:50:14]), +((Test10312.hs:50:14-23,AnnCloseP), [Test10312.hs:50:23]), +((Test10312.hs:50:14-23,AnnOpenP), [Test10312.hs:50:14]), ((Test10312.hs:50:15-18,AnnComma), [Test10312.hs:50:19]), ((Test10312.hs:52:1-22,AnnDcolon), [Test10312.hs:52:9-10]), ((Test10312.hs:52:1-22,AnnSemi), [Test10312.hs:53:1]), @@ -139,9 +139,11 @@ ((Test10312.hs:57:13-44,AnnComma), [Test10312.hs:58:11]), ((Test10312.hs:61:1-40,AnnDcolon), [Test10312.hs:61:8-9]), ((Test10312.hs:61:1-40,AnnSemi), [Test10312.hs:62:1]), +((Test10312.hs:61:11-13,AnnRarrow), [Test10312.hs:61:15-16]), ((Test10312.hs:61:11-40,AnnRarrow), [Test10312.hs:61:15-16]), ((Test10312.hs:61:18-28,AnnCloseS), [Test10312.hs:61:28]), ((Test10312.hs:61:18-28,AnnOpenS), [Test10312.hs:61:18]), +((Test10312.hs:61:18-28,AnnRarrow), [Test10312.hs:61:30-31]), ((Test10312.hs:61:18-40,AnnRarrow), [Test10312.hs:61:30-31]), ((Test10312.hs:61:33-40,AnnCloseS), [Test10312.hs:61:40]), ((Test10312.hs:61:33-40,AnnOpenS), [Test10312.hs:61:33]), @@ -167,11 +169,13 @@ ((Test10312.hs:68:19-23,AnnDarrow), [Test10312.hs:68:25-26]), ((Test10312.hs:68:28-35,AnnCloseP), [Test10312.hs:68:35]), ((Test10312.hs:68:28-35,AnnOpenP), [Test10312.hs:68:28]), +((Test10312.hs:68:28-35,AnnRarrow), [Test10312.hs:68:37-38]), ((Test10312.hs:68:28-51,AnnRarrow), [Test10312.hs:68:37-38]), ((Test10312.hs:68:29,AnnRarrow), [Test10312.hs:68:31-32]), ((Test10312.hs:68:29-34,AnnRarrow), [Test10312.hs:68:31-32]), ((Test10312.hs:68:40-42,AnnCloseS), [Test10312.hs:68:42]), ((Test10312.hs:68:40-42,AnnOpenS), [Test10312.hs:68:40]), +((Test10312.hs:68:40-42,AnnRarrow), [Test10312.hs:68:44-45]), ((Test10312.hs:68:40-51,AnnRarrow), [Test10312.hs:68:44-45]), ((Test10312.hs:68:47-51,AnnCloseS), [Test10312.hs:68:51]), ((Test10312.hs:68:47-51,AnnOpenS), [Test10312.hs:68:47]), @@ -190,6 +194,7 @@ ((Test10312.hs:71:1-50,AnnSemi), [Test10312.hs:72:1]), ((Test10312.hs:71:19-29,AnnCloseS), [Test10312.hs:71:29]), ((Test10312.hs:71:19-29,AnnOpenS), [Test10312.hs:71:19]), +((Test10312.hs:71:19-29,AnnRarrow), [Test10312.hs:71:31-32]), ((Test10312.hs:71:19-50,AnnRarrow), [Test10312.hs:71:31-32]), ((Test10312.hs:71:34-50,AnnCloseS), [Test10312.hs:71:50]), ((Test10312.hs:71:34-50,AnnOpenS), [Test10312.hs:71:34]), diff --git a/testsuite/tests/ghc-api/annotations/T10354.stdout b/testsuite/tests/ghc-api/annotations/T10354.stdout index d9094c9eb1..2e07948323 100644 --- a/testsuite/tests/ghc-api/annotations/T10354.stdout +++ b/testsuite/tests/ghc-api/annotations/T10354.stdout @@ -14,7 +14,9 @@ ((Test10354.hs:4:7-15,AnnCloseP), [Test10354.hs:4:15]), ((Test10354.hs:4:7-15,AnnOpenP), [Test10354.hs:4:7]), ((Test10354.hs:4:8-11,AnnComma), [Test10354.hs:4:12]), +((Test10354.hs:4:21,AnnRarrow), [Test10354.hs:4:23-24]), ((Test10354.hs:4:21-34,AnnRarrow), [Test10354.hs:4:23-24]), +((Test10354.hs:4:26,AnnRarrow), [Test10354.hs:4:28-29]), ((Test10354.hs:4:26-34,AnnRarrow), [Test10354.hs:4:28-29]), ((Test10354.hs:5:1-14,AnnEqual), [Test10354.hs:5:7]), ((Test10354.hs:5:1-14,AnnFunId), [Test10354.hs:5:1]), @@ -26,6 +28,7 @@ ((Test10354.hs:7:8-12,AnnDarrow), [Test10354.hs:7:14-15]), ((Test10354.hs:7:8-12,AnnOpenP), [Test10354.hs:7:8, Test10354.hs:7:8]), ((Test10354.hs:7:8-12,AnnUnit), [Test10354.hs:7:8-12]), +((Test10354.hs:7:17,AnnRarrow), [Test10354.hs:7:18-19]), ((Test10354.hs:7:17-24,AnnRarrow), [Test10354.hs:7:18-19]), ((Test10354.hs:8:1-15,AnnEqual), [Test10354.hs:8:5]), ((Test10354.hs:8:1-15,AnnFunId), [Test10354.hs:8:1-3]), @@ -33,6 +36,7 @@ ((Test10354.hs:10:1-23,AnnDcolon), [Test10354.hs:10:5-6]), ((Test10354.hs:10:1-23,AnnSemi), [Test10354.hs:11:1]), ((Test10354.hs:10:8,AnnDarrow), [Test10354.hs:10:10-11]), +((Test10354.hs:10:13,AnnRarrow), [Test10354.hs:10:15-16]), ((Test10354.hs:10:13-23,AnnRarrow), [Test10354.hs:10:15-16]), ((Test10354.hs:11:1-15,AnnEqual), [Test10354.hs:11:5]), ((Test10354.hs:11:1-15,AnnFunId), [Test10354.hs:11:1-3]), diff --git a/testsuite/tests/ghc-api/annotations/T10399.stdout b/testsuite/tests/ghc-api/annotations/T10399.stdout index e290be4e67..24f1cf41a3 100644 --- a/testsuite/tests/ghc-api/annotations/T10399.stdout +++ b/testsuite/tests/ghc-api/annotations/T10399.stdout @@ -29,9 +29,9 @@ ((Test10399.hs:12:30,AnnComma), [Test10399.hs:12:30]), ((Test10399.hs:12:31-32,AnnCloseP), [Test10399.hs:12:32]), ((Test10399.hs:12:31-32,AnnOpenP), [Test10399.hs:12:31]), -((Test10399.hs:(14,1)-(17,69),AnnData), [Test10399.hs:14:1-4]), -((Test10399.hs:(14,1)-(17,69),AnnSemi), [Test10399.hs:19:1]), -((Test10399.hs:(14,1)-(17,69),AnnWhere), [Test10399.hs:14:21-25]), +((Test10399.hs:(14,1)-(18,55),AnnData), [Test10399.hs:14:1-4]), +((Test10399.hs:(14,1)-(18,55),AnnSemi), [Test10399.hs:20:1]), +((Test10399.hs:(14,1)-(18,55),AnnWhere), [Test10399.hs:14:21-25]), ((Test10399.hs:15:5-64,AnnDcolon), [Test10399.hs:15:11-12]), ((Test10399.hs:15:5-64,AnnSemi), [Test10399.hs:16:5]), ((Test10399.hs:15:14-64,AnnDot), [Test10399.hs:15:23]), @@ -43,7 +43,10 @@ ((Test10399.hs:15:45-46,AnnBang), [Test10399.hs:15:45]), ((Test10399.hs:15:45-46,AnnRarrow), [Test10399.hs:15:48-49]), ((Test10399.hs:15:45-64,AnnRarrow), [Test10399.hs:15:48-49]), +((Test10399.hs:(16,5)-(17,69),AnnCloseP), [Test10399.hs:17:69]), ((Test10399.hs:(16,5)-(17,69),AnnDcolon), [Test10399.hs:16:12-13]), +((Test10399.hs:(16,5)-(17,69),AnnOpenP), [Test10399.hs:16:27]), +((Test10399.hs:(16,5)-(17,69),AnnSemi), [Test10399.hs:18:5]), ((Test10399.hs:(16,15)-(17,69),AnnDot), [Test10399.hs:16:25]), ((Test10399.hs:(16,15)-(17,69),AnnForall), [Test10399.hs:16:15-20]), ((Test10399.hs:(16,27)-(17,69),AnnCloseP), [Test10399.hs:17:69]), @@ -60,17 +63,28 @@ ((Test10399.hs:17:48-68,AnnRarrow), [Test10399.hs:17:50-51]), ((Test10399.hs:17:66-68,AnnCloseS), [Test10399.hs:17:68]), ((Test10399.hs:17:66-68,AnnOpenS), [Test10399.hs:17:66]), -((Test10399.hs:19:1-25,AnnCloseQ), [Test10399.hs:19:24-25]), -((Test10399.hs:19:1-25,AnnOpen), [Test10399.hs:19:1-3]), -((Test10399.hs:19:1-25,AnnSemi), [Test10399.hs:21:1]), -((Test10399.hs:19:20-22,AnnThIdSplice), [Test10399.hs:19:20-22]), -((Test10399.hs:21:1-21,AnnEqual), [Test10399.hs:21:19]), -((Test10399.hs:21:1-21,AnnFunId), [Test10399.hs:21:1-3]), -((Test10399.hs:21:1-21,AnnSemi), [Test10399.hs:22:1]), -((Test10399.hs:21:5-17,AnnCloseP), [Test10399.hs:21:17]), -((Test10399.hs:21:5-17,AnnOpenPE), [Test10399.hs:21:5-6]), -((Test10399.hs:21:8-15,AnnCloseQ), [Test10399.hs:21:14-15]), -((Test10399.hs:21:8-15,AnnOpen), [Test10399.hs:21:8-10]), -((<no location info>,AnnEofPos), [Test10399.hs:22:1]) +((Test10399.hs:18:5-55,AnnCloseP), [Test10399.hs:18:55]), +((Test10399.hs:18:5-55,AnnDcolon), [Test10399.hs:18:16-17]), +((Test10399.hs:18:5-55,AnnOpenP), [Test10399.hs:18:19]), +((Test10399.hs:18:19-55,AnnCloseP), [Test10399.hs:18:55]), +((Test10399.hs:18:19-55,AnnOpenP), [Test10399.hs:18:19]), +((Test10399.hs:18:20-54,AnnDot), [Test10399.hs:18:29]), +((Test10399.hs:18:20-54,AnnForall), [Test10399.hs:18:20-25]), +((Test10399.hs:18:31-36,AnnCloseP), [Test10399.hs:18:36]), +((Test10399.hs:18:31-36,AnnOpenP), [Test10399.hs:18:31]), +((Test10399.hs:18:31-36,AnnRarrow), [Test10399.hs:18:38-39]), +((Test10399.hs:18:31-54,AnnRarrow), [Test10399.hs:18:38-39]), +((Test10399.hs:20:1-25,AnnCloseQ), [Test10399.hs:20:24-25]), +((Test10399.hs:20:1-25,AnnOpen), [Test10399.hs:20:1-3]), +((Test10399.hs:20:1-25,AnnSemi), [Test10399.hs:22:1]), +((Test10399.hs:20:20-22,AnnThIdSplice), [Test10399.hs:20:20-22]), +((Test10399.hs:22:1-21,AnnEqual), [Test10399.hs:22:19]), +((Test10399.hs:22:1-21,AnnFunId), [Test10399.hs:22:1-3]), +((Test10399.hs:22:1-21,AnnSemi), [Test10399.hs:23:1]), +((Test10399.hs:22:5-17,AnnCloseP), [Test10399.hs:22:17]), +((Test10399.hs:22:5-17,AnnOpenPE), [Test10399.hs:22:5-6]), +((Test10399.hs:22:8-15,AnnCloseQ), [Test10399.hs:22:14-15]), +((Test10399.hs:22:8-15,AnnOpen), [Test10399.hs:22:8-10]), +((<no location info>,AnnEofPos), [Test10399.hs:23:1]) ] diff --git a/testsuite/tests/ghc-api/annotations/T10598.stdout b/testsuite/tests/ghc-api/annotations/T10598.stdout index 21029da26d..af1ac3be58 100644 --- a/testsuite/tests/ghc-api/annotations/T10598.stdout +++ b/testsuite/tests/ghc-api/annotations/T10598.stdout @@ -11,6 +11,7 @@ ((Test10598.hs:(7,1)-(9,10),AnnWhere), [Test10598.hs:7:11-15]), ((Test10598.hs:8:3-21,AnnDcolon), [Test10598.hs:8:5-6]), ((Test10598.hs:8:3-21,AnnSemi), [Test10598.hs:9:3]), +((Test10598.hs:8:8-14,AnnRarrow), [Test10598.hs:8:16-17]), ((Test10598.hs:8:8-21,AnnRarrow), [Test10598.hs:8:16-17]), ((Test10598.hs:9:3-10,AnnEqual), [Test10598.hs:9:7]), ((Test10598.hs:9:3-10,AnnFunId), [Test10598.hs:9:3]), diff --git a/testsuite/tests/ghc-api/annotations/T11018.stdout b/testsuite/tests/ghc-api/annotations/T11018.stdout index 011867e0d8..6c70c5c3d0 100644 --- a/testsuite/tests/ghc-api/annotations/T11018.stdout +++ b/testsuite/tests/ghc-api/annotations/T11018.stdout @@ -10,6 +10,7 @@ ((Test11018.hs:6:1-36,AnnSemi), [Test11018.hs:7:1]), ((Test11018.hs:6:15-36,AnnDot), [Test11018.hs:6:24]), ((Test11018.hs:6:15-36,AnnForall), [Test11018.hs:6:15-20]), +((Test11018.hs:6:26,AnnRarrow), [Test11018.hs:6:28-29]), ((Test11018.hs:6:26-36,AnnRarrow), [Test11018.hs:6:28-29]), ((Test11018.hs:(7,1)-(9,10),AnnEqual), [Test11018.hs:7:14]), ((Test11018.hs:(7,1)-(9,10),AnnFunId), [Test11018.hs:7:1-10]), @@ -70,6 +71,7 @@ ((Test11018.hs:23:1-49,AnnDcolon), [Test11018.hs:23:3-4]), ((Test11018.hs:23:1-49,AnnSemi), [Test11018.hs:24:1]), ((Test11018.hs:23:6-17,AnnDarrow), [Test11018.hs:23:19-20]), +((Test11018.hs:23:22-24,AnnRarrow), [Test11018.hs:23:26-27]), ((Test11018.hs:23:22-49,AnnRarrow), [Test11018.hs:23:26-27]), ((Test11018.hs:23:31-45,AnnCloseP), [Test11018.hs:23:45]), ((Test11018.hs:23:31-45,AnnOpenP), [Test11018.hs:23:31]), @@ -87,6 +89,7 @@ ((Test11018.hs:26:1-50,AnnDcolon), [Test11018.hs:26:4-5]), ((Test11018.hs:26:1-50,AnnSemi), [Test11018.hs:27:1]), ((Test11018.hs:26:7-18,AnnDarrow), [Test11018.hs:26:20-21]), +((Test11018.hs:26:23-25,AnnRarrow), [Test11018.hs:26:27-28]), ((Test11018.hs:26:23-50,AnnRarrow), [Test11018.hs:26:27-28]), ((Test11018.hs:26:32-46,AnnCloseP), [Test11018.hs:26:46]), ((Test11018.hs:26:32-46,AnnOpenP), [Test11018.hs:26:32]), @@ -105,6 +108,7 @@ ((Test11018.hs:31:1-26,AnnSemi), [Test11018.hs:32:1]), ((Test11018.hs:31:11-26,AnnDot), [Test11018.hs:31:15]), ((Test11018.hs:31:11-26,AnnForallU), [Test11018.hs:31:11]), +((Test11018.hs:31:17,AnnRarrowU), [Test11018.hs:31:19]), ((Test11018.hs:31:17-26,AnnRarrowU), [Test11018.hs:31:19]), ((Test11018.hs:(32,1)-(34,10),AnnEqual), [Test11018.hs:32:11]), ((Test11018.hs:(32,1)-(34,10),AnnFunId), [Test11018.hs:32:1-7]), @@ -165,6 +169,7 @@ ((Test11018.hs:48:1-49,AnnDcolon), [Test11018.hs:48:4-5]), ((Test11018.hs:48:1-49,AnnSemi), [Test11018.hs:49:1]), ((Test11018.hs:48:7-18,AnnDarrowU), [Test11018.hs:48:20]), +((Test11018.hs:48:22-24,AnnRarrow), [Test11018.hs:48:26-27]), ((Test11018.hs:48:22-49,AnnRarrow), [Test11018.hs:48:26-27]), ((Test11018.hs:48:31-45,AnnCloseP), [Test11018.hs:48:45]), ((Test11018.hs:48:31-45,AnnOpenP), [Test11018.hs:48:31]), @@ -182,6 +187,7 @@ ((Test11018.hs:51:1-50,AnnDcolon), [Test11018.hs:51:5-6]), ((Test11018.hs:51:1-50,AnnSemi), [Test11018.hs:52:1]), ((Test11018.hs:51:8-19,AnnDarrowU), [Test11018.hs:51:21]), +((Test11018.hs:51:23-25,AnnRarrow), [Test11018.hs:51:27-28]), ((Test11018.hs:51:23-50,AnnRarrow), [Test11018.hs:51:27-28]), ((Test11018.hs:51:32-46,AnnCloseP), [Test11018.hs:51:46]), ((Test11018.hs:51:32-46,AnnOpenP), [Test11018.hs:51:32]), diff --git a/testsuite/tests/ghc-api/annotations/T12417.stdout b/testsuite/tests/ghc-api/annotations/T12417.stdout index 3f61650d84..7e642dee66 100644 --- a/testsuite/tests/ghc-api/annotations/T12417.stdout +++ b/testsuite/tests/ghc-api/annotations/T12417.stdout @@ -26,6 +26,7 @@ ((Test12417.hs:12:16-31,AnnDarrow), [Test12417.hs:12:33-34]), ((Test12417.hs:12:16-31,AnnOpenP), [Test12417.hs:12:16, Test12417.hs:12:16]), ((Test12417.hs:12:17-22,AnnComma), [Test12417.hs:12:23]), +((Test12417.hs:12:36-46,AnnRarrow), [Test12417.hs:12:48-49]), ((Test12417.hs:12:36-56,AnnRarrow), [Test12417.hs:12:48-49]), ((Test12417.hs:13:1-48,AnnEqual), [Test12417.hs:13:27]), ((Test12417.hs:13:1-48,AnnFunId), [Test12417.hs:13:1-11]), @@ -54,6 +55,7 @@ ((Test12417.hs:16:60-63,AnnVbar), [Test12417.hs:16:65]), ((Test12417.hs:18:1-26,AnnDcolon), [Test12417.hs:18:13-14]), ((Test12417.hs:18:1-26,AnnSemi), [Test12417.hs:19:1]), +((Test12417.hs:18:16,AnnRarrow), [Test12417.hs:18:18-19]), ((Test12417.hs:18:16-26,AnnRarrow), [Test12417.hs:18:18-19]), ((Test12417.hs:19:1-52,AnnEqual), [Test12417.hs:19:33]), ((Test12417.hs:19:1-52,AnnFunId), [Test12417.hs:19:1-11]), diff --git a/testsuite/tests/ghc-api/annotations/T15303.stdout b/testsuite/tests/ghc-api/annotations/T15303.stdout new file mode 100644 index 0000000000..003dab5761 --- /dev/null +++ b/testsuite/tests/ghc-api/annotations/T15303.stdout @@ -0,0 +1,35 @@ +---Problems (should be empty list)--- +[] +---Annotations----------------------- +-- SrcSpan the annotation is attached to, AnnKeywordId, +-- list of locations the keyword item appears in +[ +((Test15303.hs:4:1-4,AnnCloseP), [Test15303.hs:4:4]), +((Test15303.hs:4:1-4,AnnOpenP), [Test15303.hs:4:1]), +((Test15303.hs:4:1-4,AnnVal), [Test15303.hs:4:2-3]), +((Test15303.hs:4:1-66,AnnDcolon), [Test15303.hs:4:6-7]), +((Test15303.hs:4:1-66,AnnSemi), [Test15303.hs:5:1]), +((Test15303.hs:4:9-17,AnnDarrow), [Test15303.hs:4:19-20]), +((Test15303.hs:4:22-41,AnnRarrow), [Test15303.hs:4:43-44]), +((Test15303.hs:4:22-66,AnnRarrow), [Test15303.hs:4:43-44]), +((Test15303.hs:4:33-41,AnnCloseP), [Test15303.hs:4:41]), +((Test15303.hs:4:33-41,AnnOpenP), [Test15303.hs:4:33]), +((Test15303.hs:4:36-37,AnnSimpleQuote), [Test15303.hs:4:36]), +((Test15303.hs:4:36-37,AnnVal), [Test15303.hs:4:37]), +((Test15303.hs:4:46-48,AnnRarrow), [Test15303.hs:4:50-51]), +((Test15303.hs:4:46-66,AnnRarrow), [Test15303.hs:4:50-51]), +((Test15303.hs:4:58-66,AnnCloseP), [Test15303.hs:4:66]), +((Test15303.hs:4:58-66,AnnOpenP), [Test15303.hs:4:58]), +((Test15303.hs:4:61-62,AnnSimpleQuote), [Test15303.hs:4:61]), +((Test15303.hs:4:61-62,AnnVal), [Test15303.hs:4:62]), +((Test15303.hs:5:1-4,AnnCloseP), [Test15303.hs:5:4]), +((Test15303.hs:5:1-4,AnnOpenP), [Test15303.hs:5:1]), +((Test15303.hs:5:1-4,AnnVal), [Test15303.hs:5:2-3]), +((Test15303.hs:5:1-15,AnnEqual), [Test15303.hs:5:6]), +((Test15303.hs:5:1-15,AnnFunId), [Test15303.hs:5:1-4]), +((Test15303.hs:5:1-15,AnnSemi), [Test15303.hs:6:1]), +((Test15303.hs:6:1-11,AnnInfix), [Test15303.hs:6:1-6]), +((Test15303.hs:6:1-11,AnnSemi), [Test15303.hs:7:1]), +((Test15303.hs:6:1-11,AnnVal), [Test15303.hs:6:8]), +((<no location info>,AnnEofPos), [Test15303.hs:7:1]) +] diff --git a/testsuite/tests/ghc-api/annotations/Test10399.hs b/testsuite/tests/ghc-api/annotations/Test10399.hs index 949f9f0f05..6a35712bfd 100644 --- a/testsuite/tests/ghc-api/annotations/Test10399.hs +++ b/testsuite/tests/ghc-api/annotations/Test10399.hs @@ -15,6 +15,7 @@ data MaybeDefault v where SetTo :: forall v . ( Eq v, Show v ) => !v -> MaybeDefault v SetTo4 :: forall v a. (( Eq v, Show v ) => v -> MaybeDefault v -> a -> MaybeDefault [a]) + TestParens :: (forall v . (Eq v) -> MaybeDefault v) [t| Map.Map T.Text $tc |] diff --git a/testsuite/tests/ghc-api/annotations/Test15303.hs b/testsuite/tests/ghc-api/annotations/Test15303.hs new file mode 100644 index 0000000000..212e9da5ac --- /dev/null +++ b/testsuite/tests/ghc-api/annotations/Test15303.hs @@ -0,0 +1,6 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE TypeOperators #-} + +(~#) :: Comonad w => CascadeW w (t ': ts) -> w t -> Last (t ': ts) +(~#) = cascadeW +infixr 0 ~# diff --git a/testsuite/tests/ghc-api/annotations/all.T b/testsuite/tests/ghc-api/annotations/all.T index adc0d14370..666cb3f044 100644 --- a/testsuite/tests/ghc-api/annotations/all.T +++ b/testsuite/tests/ghc-api/annotations/all.T @@ -57,3 +57,5 @@ test('T12417', [extra_files(['Test12417.hs']), ignore_stderr], run_command, ['$MAKE -s --no-print-directory T12417']) test('T13163', [extra_files(['Test13163.hs']), ignore_stderr], run_command, ['$MAKE -s --no-print-directory T13163']) +test('T15303', [extra_files(['Test15303.hs']), + ignore_stderr], run_command, ['$MAKE -s --no-print-directory T15303']) diff --git a/testsuite/tests/ghc-api/annotations/boolFormula.stdout b/testsuite/tests/ghc-api/annotations/boolFormula.stdout index c3caae10ea..d816f04eb3 100644 --- a/testsuite/tests/ghc-api/annotations/boolFormula.stdout +++ b/testsuite/tests/ghc-api/annotations/boolFormula.stdout @@ -11,42 +11,54 @@ ((TestBoolFormula.hs:(3,1)-(19,9),AnnWhere), [TestBoolFormula.hs:3:17-21]), ((TestBoolFormula.hs:4:5-25,AnnDcolon), [TestBoolFormula.hs:4:9-10]), ((TestBoolFormula.hs:4:5-25,AnnSemi), [TestBoolFormula.hs:5:5]), +((TestBoolFormula.hs:4:12,AnnRarrow), [TestBoolFormula.hs:4:14-15]), ((TestBoolFormula.hs:4:12-25,AnnRarrow), [TestBoolFormula.hs:4:14-15]), +((TestBoolFormula.hs:4:17,AnnRarrow), [TestBoolFormula.hs:4:19-20]), ((TestBoolFormula.hs:4:17-25,AnnRarrow), [TestBoolFormula.hs:4:19-20]), ((TestBoolFormula.hs:5:5-19,AnnEqual), [TestBoolFormula.hs:5:9]), ((TestBoolFormula.hs:5:5-19,AnnFunId), [TestBoolFormula.hs:5:5-7]), ((TestBoolFormula.hs:5:5-19,AnnSemi), [TestBoolFormula.hs:6:5]), ((TestBoolFormula.hs:6:5-25,AnnDcolon), [TestBoolFormula.hs:6:9-10]), ((TestBoolFormula.hs:6:5-25,AnnSemi), [TestBoolFormula.hs:7:5]), +((TestBoolFormula.hs:6:12,AnnRarrow), [TestBoolFormula.hs:6:14-15]), ((TestBoolFormula.hs:6:12-25,AnnRarrow), [TestBoolFormula.hs:6:14-15]), +((TestBoolFormula.hs:6:17,AnnRarrow), [TestBoolFormula.hs:6:19-20]), ((TestBoolFormula.hs:6:17-25,AnnRarrow), [TestBoolFormula.hs:6:19-20]), ((TestBoolFormula.hs:7:5-19,AnnEqual), [TestBoolFormula.hs:7:9]), ((TestBoolFormula.hs:7:5-19,AnnFunId), [TestBoolFormula.hs:7:5-7]), ((TestBoolFormula.hs:7:5-19,AnnSemi), [TestBoolFormula.hs:8:5]), ((TestBoolFormula.hs:8:5-25,AnnDcolon), [TestBoolFormula.hs:8:9-10]), ((TestBoolFormula.hs:8:5-25,AnnSemi), [TestBoolFormula.hs:9:5]), +((TestBoolFormula.hs:8:12,AnnRarrow), [TestBoolFormula.hs:8:14-15]), ((TestBoolFormula.hs:8:12-25,AnnRarrow), [TestBoolFormula.hs:8:14-15]), +((TestBoolFormula.hs:8:17,AnnRarrow), [TestBoolFormula.hs:8:19-20]), ((TestBoolFormula.hs:8:17-25,AnnRarrow), [TestBoolFormula.hs:8:19-20]), ((TestBoolFormula.hs:9:5-19,AnnEqual), [TestBoolFormula.hs:9:9]), ((TestBoolFormula.hs:9:5-19,AnnFunId), [TestBoolFormula.hs:9:5-7]), ((TestBoolFormula.hs:9:5-19,AnnSemi), [TestBoolFormula.hs:10:5]), ((TestBoolFormula.hs:10:5-25,AnnDcolon), [TestBoolFormula.hs:10:9-10]), ((TestBoolFormula.hs:10:5-25,AnnSemi), [TestBoolFormula.hs:11:5]), +((TestBoolFormula.hs:10:12,AnnRarrow), [TestBoolFormula.hs:10:14-15]), ((TestBoolFormula.hs:10:12-25,AnnRarrow), [TestBoolFormula.hs:10:14-15]), +((TestBoolFormula.hs:10:17,AnnRarrow), [TestBoolFormula.hs:10:19-20]), ((TestBoolFormula.hs:10:17-25,AnnRarrow), [TestBoolFormula.hs:10:19-20]), ((TestBoolFormula.hs:11:5-19,AnnEqual), [TestBoolFormula.hs:11:9]), ((TestBoolFormula.hs:11:5-19,AnnFunId), [TestBoolFormula.hs:11:5-7]), ((TestBoolFormula.hs:11:5-19,AnnSemi), [TestBoolFormula.hs:12:5]), ((TestBoolFormula.hs:12:5-25,AnnDcolon), [TestBoolFormula.hs:12:9-10]), ((TestBoolFormula.hs:12:5-25,AnnSemi), [TestBoolFormula.hs:13:5]), +((TestBoolFormula.hs:12:12,AnnRarrow), [TestBoolFormula.hs:12:14-15]), ((TestBoolFormula.hs:12:12-25,AnnRarrow), [TestBoolFormula.hs:12:14-15]), +((TestBoolFormula.hs:12:17,AnnRarrow), [TestBoolFormula.hs:12:19-20]), ((TestBoolFormula.hs:12:17-25,AnnRarrow), [TestBoolFormula.hs:12:19-20]), ((TestBoolFormula.hs:13:5-19,AnnEqual), [TestBoolFormula.hs:13:9]), ((TestBoolFormula.hs:13:5-19,AnnFunId), [TestBoolFormula.hs:13:5-7]), ((TestBoolFormula.hs:13:5-19,AnnSemi), [TestBoolFormula.hs:14:5]), ((TestBoolFormula.hs:14:5-25,AnnDcolon), [TestBoolFormula.hs:14:9-10]), ((TestBoolFormula.hs:14:5-25,AnnSemi), [TestBoolFormula.hs:15:5]), +((TestBoolFormula.hs:14:12,AnnRarrow), [TestBoolFormula.hs:14:14-15]), ((TestBoolFormula.hs:14:12-25,AnnRarrow), [TestBoolFormula.hs:14:14-15]), +((TestBoolFormula.hs:14:17,AnnRarrow), [TestBoolFormula.hs:14:19-20]), ((TestBoolFormula.hs:14:17-25,AnnRarrow), [TestBoolFormula.hs:14:19-20]), ((TestBoolFormula.hs:15:5-19,AnnEqual), [TestBoolFormula.hs:15:9]), ((TestBoolFormula.hs:15:5-19,AnnFunId), [TestBoolFormula.hs:15:5-7]), @@ -71,29 +83,39 @@ ((TestBoolFormula.hs:(21,1)-(30,47),AnnWhere), [TestBoolFormula.hs:21:13-17]), ((TestBoolFormula.hs:22:5-25,AnnDcolon), [TestBoolFormula.hs:22:9-10]), ((TestBoolFormula.hs:22:5-25,AnnSemi), [TestBoolFormula.hs:23:5]), +((TestBoolFormula.hs:22:12,AnnRarrow), [TestBoolFormula.hs:22:14-15]), ((TestBoolFormula.hs:22:12-25,AnnRarrow), [TestBoolFormula.hs:22:14-15]), +((TestBoolFormula.hs:22:17,AnnRarrow), [TestBoolFormula.hs:22:19-20]), ((TestBoolFormula.hs:22:17-25,AnnRarrow), [TestBoolFormula.hs:22:19-20]), ((TestBoolFormula.hs:23:5-25,AnnDcolon), [TestBoolFormula.hs:23:9-10]), ((TestBoolFormula.hs:23:5-25,AnnSemi), [TestBoolFormula.hs:24:5]), +((TestBoolFormula.hs:23:12,AnnRarrow), [TestBoolFormula.hs:23:14-15]), ((TestBoolFormula.hs:23:12-25,AnnRarrow), [TestBoolFormula.hs:23:14-15]), +((TestBoolFormula.hs:23:17,AnnRarrow), [TestBoolFormula.hs:23:19-20]), ((TestBoolFormula.hs:23:17-25,AnnRarrow), [TestBoolFormula.hs:23:19-20]), ((TestBoolFormula.hs:24:5-25,AnnDcolon), [TestBoolFormula.hs:24:9-10]), ((TestBoolFormula.hs:24:5-25,AnnSemi), [TestBoolFormula.hs:25:5]), +((TestBoolFormula.hs:24:12,AnnRarrow), [TestBoolFormula.hs:24:14-15]), ((TestBoolFormula.hs:24:12-25,AnnRarrow), [TestBoolFormula.hs:24:14-15]), +((TestBoolFormula.hs:24:17,AnnRarrow), [TestBoolFormula.hs:24:19-20]), ((TestBoolFormula.hs:24:17-25,AnnRarrow), [TestBoolFormula.hs:24:19-20]), ((TestBoolFormula.hs:25:5-19,AnnEqual), [TestBoolFormula.hs:25:9]), ((TestBoolFormula.hs:25:5-19,AnnFunId), [TestBoolFormula.hs:25:5-7]), ((TestBoolFormula.hs:25:5-19,AnnSemi), [TestBoolFormula.hs:26:5]), ((TestBoolFormula.hs:26:5-25,AnnDcolon), [TestBoolFormula.hs:26:9-10]), ((TestBoolFormula.hs:26:5-25,AnnSemi), [TestBoolFormula.hs:27:5]), +((TestBoolFormula.hs:26:12,AnnRarrow), [TestBoolFormula.hs:26:14-15]), ((TestBoolFormula.hs:26:12-25,AnnRarrow), [TestBoolFormula.hs:26:14-15]), +((TestBoolFormula.hs:26:17,AnnRarrow), [TestBoolFormula.hs:26:19-20]), ((TestBoolFormula.hs:26:17-25,AnnRarrow), [TestBoolFormula.hs:26:19-20]), ((TestBoolFormula.hs:27:5-19,AnnEqual), [TestBoolFormula.hs:27:9]), ((TestBoolFormula.hs:27:5-19,AnnFunId), [TestBoolFormula.hs:27:5-7]), ((TestBoolFormula.hs:27:5-19,AnnSemi), [TestBoolFormula.hs:28:5]), ((TestBoolFormula.hs:28:5-26,AnnDcolon), [TestBoolFormula.hs:28:10-11]), ((TestBoolFormula.hs:28:5-26,AnnSemi), [TestBoolFormula.hs:29:5]), +((TestBoolFormula.hs:28:13,AnnRarrow), [TestBoolFormula.hs:28:15-16]), ((TestBoolFormula.hs:28:13-26,AnnRarrow), [TestBoolFormula.hs:28:15-16]), +((TestBoolFormula.hs:28:18,AnnRarrow), [TestBoolFormula.hs:28:20-21]), ((TestBoolFormula.hs:28:18-26,AnnRarrow), [TestBoolFormula.hs:28:20-21]), ((TestBoolFormula.hs:29:5-20,AnnEqual), [TestBoolFormula.hs:29:10]), ((TestBoolFormula.hs:29:5-20,AnnFunId), [TestBoolFormula.hs:29:5-8]), diff --git a/testsuite/tests/ghc-api/annotations/listcomps.stdout b/testsuite/tests/ghc-api/annotations/listcomps.stdout index 3965257bb3..7b92474efb 100644 --- a/testsuite/tests/ghc-api/annotations/listcomps.stdout +++ b/testsuite/tests/ghc-api/annotations/listcomps.stdout @@ -131,6 +131,8 @@ (AK ListComprehensions.hs:24:11-15 AnnOpenS = [ListComprehensions.hs:24:11]) +(AK ListComprehensions.hs:24:11-15 AnnRarrow = [ListComprehensions.hs:24:17-18]) + (AK ListComprehensions.hs:24:11-27 AnnRarrow = [ListComprehensions.hs:24:17-18]) (AK ListComprehensions.hs:24:20-27 AnnCloseS = [ListComprehensions.hs:24:27]) diff --git a/testsuite/tests/ghc-api/annotations/parseTree.hs b/testsuite/tests/ghc-api/annotations/parseTree.hs index 3a8a29abd4..b04be775c3 100644 --- a/testsuite/tests/ghc-api/annotations/parseTree.hs +++ b/testsuite/tests/ghc-api/annotations/parseTree.hs @@ -51,8 +51,10 @@ testOneFile libdir fileName = do gq ast = everything (++) ([] `mkQ` doLHsTupArg) ast doLHsTupArg :: LHsTupArg GhcPs -> [(SrcSpan,String,HsExpr GhcPs)] - doLHsTupArg (L l arg@(Present _)) = [(l,"p",ExplicitTuple [L l arg] Boxed)] - doLHsTupArg (L l arg@(Missing _)) = [(l,"m",ExplicitTuple [L l arg] Boxed)] + doLHsTupArg (L l arg@(Present {})) + = [(l,"p",ExplicitTuple noExt [L l arg] Boxed)] + doLHsTupArg (L l arg@(Missing {})) + = [(l,"m",ExplicitTuple noExt [L l arg] Boxed)] showAnns anns = "[\n" ++ (intercalate "\n" diff --git a/testsuite/tests/ghc-api/annotations/stringSource.hs b/testsuite/tests/ghc-api/annotations/stringSource.hs index b89911d6c7..96702f5235 100644 --- a/testsuite/tests/ghc-api/annotations/stringSource.hs +++ b/testsuite/tests/ghc-api/annotations/stringSource.hs @@ -62,8 +62,8 @@ testOneFile libdir fileName = do doImportDecl :: ImportDecl GhcPs -> [(String,[Located (SourceText,FastString)])] - doImportDecl (ImportDecl _ _ Nothing _ _ _ _ _ _) = [] - doImportDecl (ImportDecl _ _ (Just ss) _ _ _ _ _ _) + doImportDecl (ImportDecl _ _ _ Nothing _ _ _ _ _ _) = [] + doImportDecl (ImportDecl _ _ _ (Just ss) _ _ _ _ _ _) = [("i",[conv (noLoc ss)])] doCType :: CType -> [(String,[Located (SourceText,FastString)])] @@ -73,16 +73,16 @@ testOneFile libdir fileName = do doRuleDecl :: RuleDecl GhcPs -> [(String,[Located (SourceText,FastString)])] - doRuleDecl (HsRule ss _ _ _ _ _ _) = [("r",[ss])] + doRuleDecl (HsRule _ ss _ _ _ _) = [("r",[ss])] doCCallTarget :: CCallTarget -> [(String,[Located (SourceText,FastString)])] doCCallTarget (StaticTarget s f _ _) = [("st",[(noLoc (s,f))])] doHsExpr :: HsExpr GhcPs -> [(String,[Located (SourceText,FastString)])] - doHsExpr (HsCoreAnn src ss _) = [("co",[conv (noLoc ss)])] - doHsExpr (HsSCC src ss _) = [("sc",[conv (noLoc ss)])] - doHsExpr (HsTickPragma src (ss,_,_) _ss2 _) = [("tp",[conv (noLoc ss)])] + doHsExpr (HsCoreAnn _ src ss _) = [("co",[conv (noLoc ss)])] + doHsExpr (HsSCC _ src ss _) = [("sc",[conv (noLoc ss)])] + doHsExpr (HsTickPragma _ src (ss,_,_) _ss2 _) = [("tp",[conv (noLoc ss)])] doHsExpr _ = [] conv (GHC.L l (StringLiteral st fs)) = GHC.L l (st,fs) diff --git a/testsuite/tests/ghc-api/annotations/t11430.hs b/testsuite/tests/ghc-api/annotations/t11430.hs index 4b8119459b..5a50af85f1 100644 --- a/testsuite/tests/ghc-api/annotations/t11430.hs +++ b/testsuite/tests/ghc-api/annotations/t11430.hs @@ -60,14 +60,14 @@ testOneFile libdir fileName = do doRuleDecl :: RuleDecl GhcPs -> [(String,[String])] - doRuleDecl (HsRule _ (ActiveBefore (SourceText ss) _) _ _ _ _ _) + doRuleDecl (HsRule _ _ (ActiveBefore (SourceText ss) _) _ _ _) = [("rb",[ss])] - doRuleDecl (HsRule _ (ActiveAfter (SourceText ss) _) _ _ _ _ _) + doRuleDecl (HsRule _ _ (ActiveAfter (SourceText ss) _) _ _ _) = [("ra",[ss])] - doRuleDecl (HsRule _ _ _ _ _ _ _) = [] + doRuleDecl (HsRule _ _ _ _ _ _) = [] doHsExpr :: HsExpr GhcPs -> [(String,[String])] - doHsExpr (HsTickPragma src (_,_,_) ss _) = [("tp",[show ss])] + doHsExpr (HsTickPragma _ src (_,_,_) ss _) = [("tp",[show ss])] doHsExpr _ = [] doInline (InlinePragma _ _ _ (ActiveBefore (SourceText ss) _) _) diff --git a/testsuite/tests/ghc-e/should_run/T2636.stderr b/testsuite/tests/ghc-e/should_run/T2636.stderr index bf73e40e77..9a2c6674c9 100644 --- a/testsuite/tests/ghc-e/should_run/T2636.stderr +++ b/testsuite/tests/ghc-e/should_run/T2636.stderr @@ -1,4 +1,4 @@ T2636.hs:1:1: error: Could not find module ‘MissingModule’ - Use -v to see a list of the files searched for. + Use -v (or `:set -v` in ghci) to see a list of the files searched for. diff --git a/testsuite/tests/ghci.debugger/scripts/T13825-debugger.hs b/testsuite/tests/ghci.debugger/scripts/T13825-debugger.hs new file mode 100644 index 0000000000..0c3a1de219 --- /dev/null +++ b/testsuite/tests/ghci.debugger/scripts/T13825-debugger.hs @@ -0,0 +1,33 @@ +{-# LANGUAGE MagicHash #-} +module T13825 where + +import GHC.Exts +import Data.Word +import Data.Int + +data Packed1 = Packed1 Float# Float# Int# Float# + deriving Show + +data Packed2 = + Packed2 + {-# UNPACK #-} !Float + {-# UNPACK #-} !Float + {-# UNPACK #-} !Int + {-# UNPACK #-} !Float + deriving Show + +data Packed3 = + Packed3 + {-# UNPACK #-} !Word8 + {-# UNPACK #-} !Int8 + {-# UNPACK #-} !Int64 + {-# UNPACK #-} !Word16 + {-# UNPACK #-} !Word64 + {-# UNPACK #-} !Word32 + {-# UNPACK #-} !Float + {-# UNPACK #-} !Double + deriving Show + +packed1 = Packed1 12.34# 56.78# 42# 99.99# +packed2 = Packed2 12.34 56.78 42 99.99 +packed3 = Packed3 1 2 3 4 5 6 7.8 9.0 diff --git a/testsuite/tests/ghci.debugger/scripts/T13825-debugger.script b/testsuite/tests/ghci.debugger/scripts/T13825-debugger.script new file mode 100644 index 0000000000..fc55ffc5dd --- /dev/null +++ b/testsuite/tests/ghci.debugger/scripts/T13825-debugger.script @@ -0,0 +1,7 @@ +:l T13825-debugger.hs +packed1 +:print packed1 +packed2 +:print packed2 +packed3 +:print packed3 diff --git a/testsuite/tests/ghci.debugger/scripts/T13825-debugger.stdout b/testsuite/tests/ghci.debugger/scripts/T13825-debugger.stdout new file mode 100644 index 0000000000..6d3dc2f560 --- /dev/null +++ b/testsuite/tests/ghci.debugger/scripts/T13825-debugger.stdout @@ -0,0 +1,8 @@ +Packed1 12.34# 56.78# 42# 99.99# +packed1 = Packed1 12.34 56.78 42 99.99 +Packed2 12.34 56.78 42 99.99 +packed2 = Packed2 12.34 56.78 42 99.99 +Packed3 1 2 3 4 5 6 7.8 9.0 +packed3 = Packed3 + (GHC.Word.W8# 1) (GHC.Int.I8# 2) (GHC.Int.I64# 3) (GHC.Word.W16# 4) + (GHC.Word.W64# 5) (GHC.Word.W32# 6) 7.8 9.0 diff --git a/testsuite/tests/ghci.debugger/scripts/all.T b/testsuite/tests/ghci.debugger/scripts/all.T index 96de3a334b..733631180d 100644 --- a/testsuite/tests/ghci.debugger/scripts/all.T +++ b/testsuite/tests/ghci.debugger/scripts/all.T @@ -1,4 +1,5 @@ setTestOpts([extra_run_opts('-ignore-dot-ghci'), + extra_ways(['ghci-ext']), # test with -fexternal-interpreter normalise_slashes]) test('print001', normal, ghci_script, ['print001.script']) @@ -19,10 +20,16 @@ test('print016', extra_files(['../Test.hs']), ghci_script, ['print016.script']) test('print017', extra_files(['../Test.hs']), ghci_script, ['print017.script']) test('print018', extra_files(['../Test.hs']), ghci_script, ['print018.script']) test('print019', extra_files(['../Test.hs']), ghci_script, ['print019.script']) -test('print020', extra_files(['../HappyTest.hs']), ghci_script, ['print020.script']) + +# The ghci-ext way emits messages in a slightly different order due to +# printing from two processes, so let's just skip it. +test('print020', [extra_files(['../HappyTest.hs']), + omit_ways(['ghci-ext'])], ghci_script, ['print020.script']) + test('print021', normal, ghci_script, ['print021.script']) -test('print022', when(arch('powerpc64'), expect_broken(11262)), - ghci_script, ['print022.script']) +test('print022', + [when(arch('powerpc64'), expect_broken(14455))], + ghci_script, ['print022.script']) test('print023', extra_files(['../Test.hs']), ghci_script, ['print023.script']) test('print024', extra_files(['../Test.hs']), ghci_script, ['print024.script']) test('print025', normal, ghci_script, ['print025.script']) @@ -50,8 +57,7 @@ test('break009', [extra_files(['../Test6.hs']), test('break010', extra_files(['../Test6.hs']), ghci_script, ['break010.script']) test('break011', [extra_files(['../Test7.hs']), - combined_output, - when(msys(), expect_broken(12712))], + combined_output], ghci_script, ['break011.script']) test('break012', normal, ghci_script, ['break012.script']) test('break013', normal, ghci_script, ['break013.script']) @@ -86,7 +92,10 @@ test('listCommand001', [extra_files(['../Test3.hs']), combined_output], ghci_script, ['listCommand001.script']) test('listCommand002', normal, ghci_script, ['listCommand002.script']) -test('hist001', extra_files(['../Test3.hs']), ghci_script, ['hist001.script']) +test('hist001', [extra_files(['../Test3.hs']), extra_run_opts('+RTS -I0')], + ghci_script, ['hist001.script']) +test('hist002', [extra_files(['../Test3.hs']), extra_run_opts('+RTS -I0')], + ghci_script, ['hist002.script']) test('T2740', normal, ghci_script, ['T2740.script']) @@ -94,3 +103,7 @@ test('getargs', extra_files(['../getargs.hs']), ghci_script, ['getargs.script']) test('T7386', normal, ghci_script, ['T7386.script']) test('T8557', normal, ghci_script, ['T8557.script']) test('T12458', normal, ghci_script, ['T12458.script']) +test('T13825-debugger', when(arch('powerpc64'), expect_broken(14455)), + ghci_script, ['T13825-debugger.script']) + +test('break029', extra_files(['break029.hs']), ghci_script, ['break029.script']) diff --git a/testsuite/tests/ghci.debugger/scripts/break006.stderr b/testsuite/tests/ghci.debugger/scripts/break006.stderr index f19a5b3896..4622cb53e9 100644 --- a/testsuite/tests/ghci.debugger/scripts/break006.stderr +++ b/testsuite/tests/ghci.debugger/scripts/break006.stderr @@ -9,7 +9,7 @@ instance Show Integer -- Defined in ‘GHC.Show’ instance Show a => Show (Maybe a) -- Defined in ‘GHC.Show’ ...plus 22 others - ...plus 11 instances involving out-of-scope types + ...plus 18 instances involving out-of-scope types (use -fprint-potential-instances to see them all) • In a stmt of an interactive GHCi command: print it @@ -23,6 +23,6 @@ instance Show Integer -- Defined in ‘GHC.Show’ instance Show a => Show (Maybe a) -- Defined in ‘GHC.Show’ ...plus 22 others - ...plus 11 instances involving out-of-scope types + ...plus 18 instances involving out-of-scope types (use -fprint-potential-instances to see them all) • In a stmt of an interactive GHCi command: print it diff --git a/testsuite/tests/ghci.debugger/scripts/break006.stdout b/testsuite/tests/ghci.debugger/scripts/break006.stdout index 8a2463fa4e..cd9f6ea1fe 100644 --- a/testsuite/tests/ghci.debugger/scripts/break006.stdout +++ b/testsuite/tests/ghci.debugger/scripts/break006.stdout @@ -4,14 +4,14 @@ f :: Integer -> a = _ x :: Integer = 1 xs :: [Integer] = [2,3] xs :: [Integer] = [2,3] -x :: Integer = 1 f :: Integer -> a = _ +x :: Integer = 1 _result :: [a] = _ y = (_t1::a) y = 2 xs :: [Integer] = [2,3] -x :: Integer = 1 f :: Integer -> Integer = _ +x :: Integer = 1 _result :: [Integer] = _ y :: Integer = 2 _t1 :: Integer = 2 diff --git a/testsuite/tests/ghci.debugger/scripts/break011.stdout b/testsuite/tests/ghci.debugger/scripts/break011.stdout index ac5b7e3a24..47fb7b135d 100644 --- a/testsuite/tests/ghci.debugger/scripts/break011.stdout +++ b/testsuite/tests/ghci.debugger/scripts/break011.stdout @@ -23,13 +23,6 @@ _exception = SomeException "foo" "CallStack (from HasCallStack): error, called at Test7.hs:2:18 in main:Main") -Ghci1._exception :: SomeException = SomeException - (ErrorCallWithLocation - "foo" - "CallStack (from HasCallStack): - error, called at Test7.hs:<line>:<column> in <package-id>:Main") -Ghci2._result :: a = _ -Ghci3._result :: IO a = _ _result :: a = _ _exception :: SomeException = SomeException (ErrorCallWithLocation diff --git a/testsuite/tests/ghci.debugger/scripts/break012.stdout b/testsuite/tests/ghci.debugger/scripts/break012.stdout index 2e86b42713..5d478ae04e 100644 --- a/testsuite/tests/ghci.debugger/scripts/break012.stdout +++ b/testsuite/tests/ghci.debugger/scripts/break012.stdout @@ -1,14 +1,14 @@ Stopped in Main.g, break012.hs:5:10-18 -_result :: (p, a1 -> a1, (), a -> a -> a) = _ -a :: p = _ -b :: a2 -> a2 = _ +_result :: (a1, a2 -> a2, (), a -> a -> a) = _ +a :: a1 = _ +b :: a3 -> a3 = _ c :: () = _ d :: a -> a -> a = _ -a :: p -b :: a2 -> a2 +a :: a1 +b :: a3 -> a3 c :: () d :: a -> a -> a -a = (_t1::p) -b = (_t2::a2 -> a2) +a = (_t1::a1) +b = (_t2::a3 -> a3) c = (_t3::()) d = (_t4::a -> a -> a) diff --git a/testsuite/tests/ghci.debugger/scripts/break029.hs b/testsuite/tests/ghci.debugger/scripts/break029.hs new file mode 100644 index 0000000000..7598d3f4b3 --- /dev/null +++ b/testsuite/tests/ghci.debugger/scripts/break029.hs @@ -0,0 +1,6 @@ +{-# LANGUAGE ApplicativeDo #-} + +f :: Int -> IO Int +f x = do + y <- return (x + 1) + return (y * 2) diff --git a/testsuite/tests/ghci.debugger/scripts/break029.script b/testsuite/tests/ghci.debugger/scripts/break029.script new file mode 100644 index 0000000000..b2e70b1ba5 --- /dev/null +++ b/testsuite/tests/ghci.debugger/scripts/break029.script @@ -0,0 +1,5 @@ +:load break029.hs +:step f 3 +:step +:step +y diff --git a/testsuite/tests/ghci.debugger/scripts/break029.stdout b/testsuite/tests/ghci.debugger/scripts/break029.stdout new file mode 100644 index 0000000000..c1d7047a8e --- /dev/null +++ b/testsuite/tests/ghci.debugger/scripts/break029.stdout @@ -0,0 +1,10 @@ +Stopped in Main.f, break029.hs:(4,7)-(6,16) +_result :: IO Int = _ +x :: Int = 3 +Stopped in Main.f, break029.hs:5:8-21 +_result :: IO Int = _ +x :: Int = 3 +Stopped in Main.f, break029.hs:6:11-15 +_result :: Int = _ +y :: Int = _ +4 diff --git a/testsuite/tests/ghci.debugger/scripts/hist001.stdout b/testsuite/tests/ghci.debugger/scripts/hist001.stdout index 523605b00a..b52e8aa5fe 100644 --- a/testsuite/tests/ghci.debugger/scripts/hist001.stdout +++ b/testsuite/tests/ghci.debugger/scripts/hist001.stdout @@ -12,7 +12,6 @@ Logged breakpoint at Test3.hs:2:22-31 _result :: [a] f :: t -> a xs :: [t] -Ghci1._result :: [a] = _ xs :: [t] = [] f :: t -> a = _ _result :: [a] = _ @@ -20,12 +19,9 @@ Logged breakpoint at Test3.hs:2:18-20 _result :: a f :: Integer -> a x :: Integer -Ghci1._result :: [a] = _ xs :: [t] = [] -Ghci2.f :: t -> a = _ -Ghci2._result :: [a] = _ -x :: Integer = 2 f :: Integer -> a = _ +x :: Integer = 2 _result :: a = _ _result = 3 Logged breakpoint at Test3.hs:2:18-31 diff --git a/testsuite/tests/ghci.debugger/scripts/hist002.script b/testsuite/tests/ghci.debugger/scripts/hist002.script new file mode 100644 index 0000000000..0198207192 --- /dev/null +++ b/testsuite/tests/ghci.debugger/scripts/hist002.script @@ -0,0 +1,20 @@ +:l Test3.hs +-- set a break on the [] case in map +:b 1 +-- trace an execution +:tr mymap (+1) [1,2] +:hist +:back +:show bindings +:back +:show bindings +:force _result +-- Run a GC so the BLACKHOLE indirection for _result (the AP_STACK) is removed, +-- ensuring _result now points directly to the value (in this case, the integer +-- 3). This will be tagged, so we are checking that the pointer isn't naively +-- dereferenced to generate an unaligned load. +System.Mem.performGC +:back +:forward +-- at this point, we can't retrieve the bindings because _result (the AP_STACK) +-- was evaluated previously. GHCi should not crash, preferably. diff --git a/testsuite/tests/ghci.debugger/scripts/hist002.stdout b/testsuite/tests/ghci.debugger/scripts/hist002.stdout new file mode 100644 index 0000000000..b52e8aa5fe --- /dev/null +++ b/testsuite/tests/ghci.debugger/scripts/hist002.stdout @@ -0,0 +1,33 @@ +Breakpoint 0 activated at Test3.hs:1:14-15 +[2,3Stopped in Main.mymap, Test3.hs:1:14-15 +_result :: [a] = _ +-1 : mymap (Test3.hs:2:22-31) +-2 : mymap (Test3.hs:2:18-20) +-3 : mymap (Test3.hs:2:18-31) +-4 : mymap (Test3.hs:2:22-31) +-5 : mymap (Test3.hs:2:18-20) +-6 : mymap (Test3.hs:2:18-31) +<end of history> +Logged breakpoint at Test3.hs:2:22-31 +_result :: [a] +f :: t -> a +xs :: [t] +xs :: [t] = [] +f :: t -> a = _ +_result :: [a] = _ +Logged breakpoint at Test3.hs:2:18-20 +_result :: a +f :: Integer -> a +x :: Integer +xs :: [t] = [] +f :: Integer -> a = _ +x :: Integer = 2 +_result :: a = _ +_result = 3 +Logged breakpoint at Test3.hs:2:18-31 +_result :: [a] +f :: Integer -> a +x :: Integer +xs :: [Integer] +Logged breakpoint at Test3.hs:2:18-20 +_result :: a diff --git a/testsuite/tests/ghci.debugger/scripts/print003.stdout b/testsuite/tests/ghci.debugger/scripts/print003.stdout index 74f18d264b..23b0543c1f 100644 --- a/testsuite/tests/ghci.debugger/scripts/print003.stdout +++ b/testsuite/tests/ghci.debugger/scripts/print003.stdout @@ -1,13 +1,13 @@ -t = O (_t1::a) +t = O (_t1::a0) t :: Opaque = O _ -_t1 :: a = _ +_t1 :: a0 = _ () -t = O ((_t2::a1) : (_t3::[a1])) +t = O ((_t2::a0) : (_t3::[a0])) t :: Opaque = O (_ : _) _t1 :: [a] = _ : _ it :: () = () -_t3 :: [a1] = _ -_t2 :: a1 = _ +_t3 :: [a0] = _ +_t2 :: a0 = _ () t = O (Just [1,1] : (_t4::[Maybe [Integer]])) () diff --git a/testsuite/tests/ghci.debugger/scripts/print006.stdout b/testsuite/tests/ghci.debugger/scripts/print006.stdout index 1cf7de8a8e..e508e68c34 100644 --- a/testsuite/tests/ghci.debugger/scripts/print006.stdout +++ b/testsuite/tests/ghci.debugger/scripts/print006.stdout @@ -1,8 +1,8 @@ -t = O (_t1::a) +t = O (_t1::a0) () -t = O ((_t2::a1) : (_t3::[a1])) +t = O ((_t2::a0) : (_t3::[a0])) () -t = O ((_t4::a2) : (_t5::a2) : (_t6::[a2])) +t = O ((_t4::a1) : (_t5::a1) : (_t6::[a1])) () t = O ((_t7::Maybe [Integer]) : Just [2,2] : (_t8::[Maybe [Integer]])) diff --git a/testsuite/tests/ghci.debugger/scripts/print008.stdout b/testsuite/tests/ghci.debugger/scripts/print008.stdout index 08bdbf7b1d..4cfb5ba7df 100644 --- a/testsuite/tests/ghci.debugger/scripts/print008.stdout +++ b/testsuite/tests/ghci.debugger/scripts/print008.stdout @@ -1,7 +1,7 @@ -t = O (_t1::a) -_t1 :: a +t = O (_t1::a0) +_t1 :: a0 () -t = O ((_t2::a1) : (_t3::[a1])) +t = O ((_t2::a0) : (_t3::[a0])) () t = O (Just [1,1] : (_t4::[Maybe [Integer]])) _t4 :: [Maybe [Integer]] diff --git a/testsuite/tests/ghci.debugger/scripts/print010.stdout b/testsuite/tests/ghci.debugger/scripts/print010.stdout index b390d255c8..dd75dc246c 100644 --- a/testsuite/tests/ghci.debugger/scripts/print010.stdout +++ b/testsuite/tests/ghci.debugger/scripts/print010.stdout @@ -1,6 +1,6 @@ -o = O (_t1::a) +o = O (_t1::a0) () -o = O ((_t2::a1) : (_t3::[a1])) +o = O ((_t2::a0) : (_t3::[a0])) () 3 o = O [0,(_t4::Integer),(_t5::Integer),(_t6::Integer)] diff --git a/testsuite/tests/ghci.debugger/scripts/print012.stdout b/testsuite/tests/ghci.debugger/scripts/print012.stdout index 905ac7656c..e77bb39b15 100644 --- a/testsuite/tests/ghci.debugger/scripts/print012.stdout +++ b/testsuite/tests/ghci.debugger/scripts/print012.stdout @@ -1,6 +1,6 @@ -o = O (_t1::a) +o = O (_t1::a0) () _t1 :: SafeList Integer NonEmpty -o = O (Cons 3 (_t4::SafeList Integer y)) +o = O (Cons 3 (_t4::SafeList Integer y0)) () -o = O (Cons 3 (Cons 6 (_t9::SafeList Integer y))) +o = O (Cons 3 (Cons 6 (_t9::SafeList Integer y0))) diff --git a/testsuite/tests/ghci.debugger/scripts/print019.stderr b/testsuite/tests/ghci.debugger/scripts/print019.stderr index c266bc8d1a..5815080f6a 100644 --- a/testsuite/tests/ghci.debugger/scripts/print019.stderr +++ b/testsuite/tests/ghci.debugger/scripts/print019.stderr @@ -9,6 +9,6 @@ instance Show TyCon -- Defined in ‘GHC.Show’ instance Show Integer -- Defined in ‘GHC.Show’ ...plus 29 others - ...plus 12 instances involving out-of-scope types + ...plus 19 instances involving out-of-scope types (use -fprint-potential-instances to see them all) • In a stmt of an interactive GHCi command: print it diff --git a/testsuite/tests/ghci.debugger/scripts/print019.stdout b/testsuite/tests/ghci.debugger/scripts/print019.stdout index aea474019d..932fd540c3 100644 --- a/testsuite/tests/ghci.debugger/scripts/print019.stdout +++ b/testsuite/tests/ghci.debugger/scripts/print019.stdout @@ -1,4 +1,4 @@ -a = O (_t1::a) +a = O (_t1::a0) b = O (_t2::a1) () _t1 = 'a' diff --git a/testsuite/tests/ghci.debugger/scripts/print034.stdout b/testsuite/tests/ghci.debugger/scripts/print034.stdout index 5d83c8c9b7..f497209e87 100644 --- a/testsuite/tests/ghci.debugger/scripts/print034.stdout +++ b/testsuite/tests/ghci.debugger/scripts/print034.stdout @@ -1,4 +1,4 @@ -o = O (_t1::a) +o = O (_t1::a0) () _t1 :: SafeList Bool NonEmpty o = O (One False (_t4::SafeList Bool Empty)) diff --git a/testsuite/tests/ghci/linking/Makefile b/testsuite/tests/ghci/linking/Makefile index 793152d68e..793998eb92 100644 --- a/testsuite/tests/ghci/linking/Makefile +++ b/testsuite/tests/ghci/linking/Makefile @@ -40,11 +40,11 @@ ghcilink002 : ghcilink003 : echo ":q" | "$(TEST_HC)" $(TEST_HC_OPTS_INTERACTIVE) -lstdc++ -# Test 4: +# Test 4: # package P # library-dirs: `pwd`/dir004 # extra-libraries: foo -# with +# with # dir004/libfoo.a LOCAL_PKGCONF004=dir004/local.package.conf @@ -68,11 +68,11 @@ ghcilink004 : "$(AR)" cqs dir004/libfoo.a dir004/foo.o echo "test" | "$(TEST_HC)" $(TEST_HC_OPTS_INTERACTIVE) -package-db $(LOCAL_PKGCONF004) -package test TestLink.hs -# Test 5: +# Test 5: # package P # library-dirs: `pwd`/dir005 # extra-libraries: foo -# with +# with # dir005/libfoo.so LOCAL_PKGCONF005=dir005/ghcilink005.package.conf @@ -96,7 +96,7 @@ ghcilink005 : "$(TEST_HC)" -no-auto-link-packages -shared -o dir005/$(call DLL,foo) dir005/foo.o echo "test" | "$(TEST_HC)" $(TEST_HC_OPTS_INTERACTIVE) -package-db $(LOCAL_PKGCONF005) -package test TestLink.hs -# Test 6: +# Test 6: # package P # extra-libraries: stdc++ @@ -126,3 +126,11 @@ endif T3333: "$(TEST_HC)" -c T3333.c -o T3333.o echo "weak_test 10" | "$(TEST_HC)" $(TEST_HC_OPTS_INTERACTIVE) T3333.hs T3333.o + +.PHONY: T14708 +T14708: + $(RM) -rf T14708scratch + mkdir T14708scratch + "$(TEST_HC)" -c add.c -o T14708scratch/add.o + "$(AR)" cqs T14708scratch/libadd.a T14708scratch/add.o + -"$(TEST_HC)" $(TEST_HC_OPTS_INTERACTIVE) -LT14708scratch -ladd T14708.hs diff --git a/testsuite/tests/ghci/linking/T14708.hs b/testsuite/tests/ghci/linking/T14708.hs new file mode 100644 index 0000000000..377b6b5516 --- /dev/null +++ b/testsuite/tests/ghci/linking/T14708.hs @@ -0,0 +1,2 @@ +main :: IO () +main = return () diff --git a/testsuite/tests/ghci/linking/T14708.stderr b/testsuite/tests/ghci/linking/T14708.stderr new file mode 100644 index 0000000000..fabbdb40f2 --- /dev/null +++ b/testsuite/tests/ghci/linking/T14708.stderr @@ -0,0 +1,4 @@ +<command line>: User-specified static library could not be loaded (T14708scratch/libadd.a) +Loading static libraries is not supported in this configuration. +Try using a dynamic library instead. + diff --git a/testsuite/tests/ghci/linking/add.c b/testsuite/tests/ghci/linking/add.c new file mode 100644 index 0000000000..538880cdc1 --- /dev/null +++ b/testsuite/tests/ghci/linking/add.c @@ -0,0 +1 @@ +int add2(int x, int y) { return x + y; } diff --git a/testsuite/tests/ghci/linking/all.T b/testsuite/tests/ghci/linking/all.T index 124b3a40b7..f9617c5cf7 100644 --- a/testsuite/tests/ghci/linking/all.T +++ b/testsuite/tests/ghci/linking/all.T @@ -31,3 +31,11 @@ test('T3333', unless(opsys('linux') or opsys('darwin') or ghc_dynamic(), expect_broken(3333))], run_command, ['$MAKE -s --no-print-directory T3333']) + +test('T14708', + [extra_files(['T14708.hs', 'add.c']), + unless(doing_ghci, skip), + unless(ghc_dynamic(), skip), + extra_clean(['T14708scratch/*', 'T14708'])], + run_command, + ['$MAKE -s --no-print-directory T14708']) diff --git a/testsuite/tests/ghci/linking/dyn/Makefile b/testsuite/tests/ghci/linking/dyn/Makefile index 8a627919eb..d4a65a6603 100644 --- a/testsuite/tests/ghci/linking/dyn/Makefile +++ b/testsuite/tests/ghci/linking/dyn/Makefile @@ -101,7 +101,7 @@ T1407: .PHONY: T13606 T13606: - echo "main" | '$(TEST_HC)' $(TEST_HC_OPTS_INTERACTIVE) -lD3DCompiler T13606.hs + echo ":q" | '$(TEST_HC)' $(TEST_HC_OPTS_INTERACTIVE) -lgcc_s .PHONY: big-obj big-obj: diff --git a/testsuite/tests/ghci/linking/dyn/T13606.hs b/testsuite/tests/ghci/linking/dyn/T13606.hs deleted file mode 100644 index 3bce51a761..0000000000 --- a/testsuite/tests/ghci/linking/dyn/T13606.hs +++ /dev/null @@ -1,128 +0,0 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE ScopedTypeVariables #-} -module Main (main) where - -import Data.Bits (Bits(..)) -import Data.Int (Int32) -import Data.Word (Word32) -import Foreign.C.String (CString, peekCString, withCString, withCStringLen) -import Foreign.Marshal.Alloc (alloca) -import Foreign.Ptr (Ptr, castPtr, nullPtr) -import Foreign.Storable (Storable(..)) -import System.IO (IOMode(..), hGetContents, withFile) - -#if defined(i386_HOST_ARCH) -# define WINDOWS_CCONV stdcall -#elif defined(x86_64_HOST_ARCH) -# define WINDOWS_CCONV ccall -#else -# error Unknown mingw32 arch -#endif - -foreign import WINDOWS_CCONV "D3DCompile" c_d3dCompile - :: Ptr () -> Word32 -> CString -> - Ptr D3DShaderMacro -> Ptr ID3DInclude -> - CString -> CString -> D3DCompileFlag -> D3DCompileEffectFlag -> - Ptr (Ptr ID3DBlob) -> Ptr (Ptr ID3DBlob) -> IO HRESULT - -maybePoke :: (Storable a) => Maybe a -> (Ptr a -> IO b) -> IO b -maybePoke Nothing proc = proc nullPtr -maybePoke (Just m) proc = alloca $ \ptr -> do - poke ptr m - proc ptr - -maybeWithCString :: Maybe String -> (CString -> IO a) -> IO a -maybeWithCString Nothing proc = proc nullPtr -maybeWithCString (Just m) proc = withCString m proc - -type HRESULT = LONG -data ID3DBlob = ID3DBlob -data ID3DInclude = ID3DInclue -type LONG = Int32 - -data D3DShaderMacro = D3DShaderMacro - { _name :: String - , _definition :: String } - -instance Storable D3DShaderMacro where - sizeOf _ = 8 - alignment _ = 8 - peek ptr = do - n <- peekByteOff ptr 0 - d <- peekByteOff ptr 4 - n' <- peekCString n - d' <- peekCString d - return $ D3DShaderMacro n' d' - poke ptr (D3DShaderMacro n d) = do - withCString n $ \n' -> withCString d $ \d' -> do - pokeByteOff ptr 0 n' - pokeByteOff ptr 4 d' - -type D3DCompileFlag = Word32 -type D3DCompileEffectFlag = Word32 - -d3dCompileEnableStrictness :: D3DCompileFlag -d3dCompileEnableStrictness = shift 1 11 - -d3dCompile - :: String -> Maybe String -> - Maybe D3DShaderMacro -> Ptr ID3DInclude -> - Maybe String -> String -> - [D3DCompileFlag] -> [D3DCompileEffectFlag] -> - IO (Either (HRESULT, Ptr ID3DBlob) (Ptr ID3DBlob)) -d3dCompile source sourceName defines pInclude entryPoint target compileFlags effectFlags = do - withCStringLen source $ \(csource, len) -> withCString target $ \pTarget -> - maybeWithCString sourceName $ \pSourceName -> maybePoke defines $ \pDefines -> - maybeWithCString entryPoint $ \pEntryPoint -> alloca $ \ppCode -> alloca $ \ppErrorMsgs -> do - let sFlag = foldl (.|.) 0 compileFlags - let eFlag = foldl (.|.) 0 effectFlags - putStrLn "Before d3dCompile" - hr <- c_d3dCompile - (castPtr csource) - (fromIntegral len) - pSourceName - pDefines - pInclude - pEntryPoint - pTarget - sFlag - eFlag - ppCode - ppErrorMsgs - putStrLn "After d3dCompile" - if hr < 0 - then do - pErrorMsgs <- peek ppErrorMsgs - return $ Left (hr, pErrorMsgs) - else do - pCode <- peek ppCode - return $ Right pCode - -d3dCompileFromFile - :: String -> Maybe String -> - Maybe D3DShaderMacro -> Ptr ID3DInclude -> - Maybe String -> String -> - [D3DCompileFlag] -> [D3DCompileEffectFlag] -> - IO (Either (HRESULT, Ptr ID3DBlob) (Ptr ID3DBlob)) -d3dCompileFromFile fileName sourceName defines pInclude entryPoint target compileFlags effectFlags = - withFile fileName ReadMode $ \handle -> do - contents <- hGetContents handle - d3dCompile contents sourceName defines pInclude entryPoint target compileFlags effectFlags - -main :: IO () -main = do - _vb <- compileShaderFromFile "Triangle.fx" "VS" "vs_4_0" - return () - -compileShaderFromFile :: String -> String -> String -> IO (Ptr ID3DBlob) -compileShaderFromFile fileName entryPoint shaderModel = do - Right res <- d3dCompileFromFile - fileName - Nothing - Nothing - nullPtr - (Just entryPoint) - shaderModel - [d3dCompileEnableStrictness] - [] - return res diff --git a/testsuite/tests/ghci/linking/dyn/T13606.stdout b/testsuite/tests/ghci/linking/dyn/T13606.stdout deleted file mode 100644 index baf6b87f26..0000000000 --- a/testsuite/tests/ghci/linking/dyn/T13606.stdout +++ /dev/null @@ -1,2 +0,0 @@ -Before d3dCompile -After d3dCompile diff --git a/testsuite/tests/ghci/linking/dyn/Triangle.fx b/testsuite/tests/ghci/linking/dyn/Triangle.fx deleted file mode 100644 index 0cef7a1e0f..0000000000 --- a/testsuite/tests/ghci/linking/dyn/Triangle.fx +++ /dev/null @@ -1,10 +0,0 @@ -float4 VS( float4 Pos : POSITION ) : SV_POSITION -{ - return Pos; -} - -float4 PS( float4 Pos : SV_POSITION ) : SV_Target -{ - return float4( 1.0f, 1.0f, 0.0f, 1.0f ); // Yellow, with Alpha = 1 -} - diff --git a/testsuite/tests/ghci/linking/dyn/all.T b/testsuite/tests/ghci/linking/dyn/all.T index 752dc78392..f8679bcbfe 100644 --- a/testsuite/tests/ghci/linking/dyn/all.T +++ b/testsuite/tests/ghci/linking/dyn/all.T @@ -39,8 +39,8 @@ test('T11072msvc', [extra_files(['A.c', 'T11072.hs', 'libAS.def', 'i686/', 'x86_ unless(doing_ghci, skip), unless(opsys('mingw32'), skip)], run_command, ['$MAKE -s --no-print-directory compile_libAS_impl_msvc']) -test('T13606', [extra_files(['Triangle.fx']), - unless(doing_ghci, skip), unless(opsys('mingw32'), skip)], +test('T13606', [unless(doing_ghci, skip), unless(opsys('mingw32'), skip), + exit_code(0)], run_command, ['$MAKE -s --no-print-directory T13606']) test('big-obj', [extra_files(['big-obj-c.c', 'big-obj.hs']), diff --git a/testsuite/tests/ghci/prog011/prog011.T b/testsuite/tests/ghci/prog011/prog011.T index c14d457b10..1614aaa7e1 100644 --- a/testsuite/tests/ghci/prog011/prog011.T +++ b/testsuite/tests/ghci/prog011/prog011.T @@ -1,2 +1,2 @@ -test('prog011', reqlib('mtl'), ghci_script, ['prog011.script']) +test('prog011', normal, ghci_script, ['prog011.script']) diff --git a/testsuite/tests/ghci/scripts/Defer02.stderr b/testsuite/tests/ghci/scripts/Defer02.stderr index 5aa67f06c3..63dbc9b042 100644 --- a/testsuite/tests/ghci/scripts/Defer02.stderr +++ b/testsuite/tests/ghci/scripts/Defer02.stderr @@ -12,16 +12,11 @@ Defer01.hs:14:5: warning: [-Wdeferred-type-errors (in -Wdefault)] • In the expression: 'p' In an equation for ‘a’: a = 'p' -Defer01.hs:18:7: warning: [-Wdeferred-type-errors (in -Wdefault)] - • No instance for (Eq B) arising from a use of ‘==’ - • In the expression: x == x - In an equation for ‘b’: b x = x == x - Defer01.hs:25:1: warning: [-Woverlapping-patterns (in -Wdefault)] Pattern match has inaccessible right hand side In an equation for ‘c’: c (C2 x) = ... -Defer01.hs:25:4: warning: [-Wdeferred-type-errors (in -Wdefault)] +Defer01.hs:25:4: warning: [-Winaccessible-code (in -Wdefault)] • Couldn't match type ‘Int’ with ‘Bool’ Inaccessible code in a pattern with constructor: C2 :: Bool -> C Bool, @@ -29,12 +24,6 @@ Defer01.hs:25:4: warning: [-Wdeferred-type-errors (in -Wdefault)] • In the pattern: C2 x In an equation for ‘c’: c (C2 x) = True -Defer01.hs:28:5: warning: [-Wdeferred-type-errors (in -Wdefault)] - • No instance for (Num (a -> a)) arising from the literal ‘1’ - (maybe you haven't applied a function to enough arguments?) - • In the expression: 1 - In an equation for ‘d’: d = 1 - Defer01.hs:31:5: warning: [-Wdeferred-type-errors (in -Wdefault)] • Couldn't match expected type ‘Char -> t’ with actual type ‘Char’ • The function ‘e’ is applied to one argument, @@ -59,31 +48,12 @@ Defer01.hs:34:8: warning: [-Wdeferred-type-errors (in -Wdefault)] Defer01.hs:39:17: warning: [-Wdeferred-type-errors (in -Wdefault)] • Couldn't match expected type ‘Bool’ with actual type ‘T a’ • In the first argument of ‘not’, namely ‘(K a)’ - In the expression: (not (K a)) + In the first argument of ‘seq’, namely ‘(not (K a))’ In the expression: seq (not (K a)) () • Relevant bindings include a :: a (bound at Defer01.hs:39:3) i :: a -> () (bound at Defer01.hs:39:1) -Defer01.hs:43:5: warning: [-Wdeferred-type-errors (in -Wdefault)] - • No instance for (MyClass a1) arising from a use of ‘myOp’ - • In the expression: myOp 23 - In an equation for ‘j’: j = myOp 23 - -Defer01.hs:43:10: warning: [-Wdeferred-type-errors (in -Wdefault)] - • Ambiguous type variable ‘a1’ arising from the literal ‘23’ - prevents the constraint ‘(Num a1)’ from being solved. - Probable fix: use a type annotation to specify what ‘a1’ should be. - These potential instances exist: - instance Num Integer -- Defined in ‘GHC.Num’ - instance Num Double -- Defined in ‘GHC.Float’ - instance Num Float -- Defined in ‘GHC.Float’ - ...plus two others - (use -fprint-potential-instances to see them all) - • In the first argument of ‘myOp’, namely ‘23’ - In the expression: myOp 23 - In an equation for ‘j’: j = myOp 23 - Defer01.hs:47:7: warning: [-Wdeferred-type-errors (in -Wdefault)] • Couldn't match expected type ‘Bool’ with actual type ‘Int’ • In the expression: x @@ -152,7 +122,7 @@ Defer01.hs:50:5: warning: [-Wdeferred-type-errors (in -Wdefault)] *** Exception: Defer01.hs:39:17: error: • Couldn't match expected type ‘Bool’ with actual type ‘T a’ • In the first argument of ‘not’, namely ‘(K a)’ - In the expression: (not (K a)) + In the first argument of ‘seq’, namely ‘(not (K a))’ In the expression: seq (not (K a)) () • Relevant bindings include a :: a (bound at Defer01.hs:39:3) diff --git a/testsuite/tests/ghci/scripts/Makefile b/testsuite/tests/ghci/scripts/Makefile index 5f848656c5..40ba561f69 100644 --- a/testsuite/tests/ghci/scripts/Makefile +++ b/testsuite/tests/ghci/scripts/Makefile @@ -61,3 +61,8 @@ T11389: # (without -v0) '$(TEST_HC)' $(filter-out -v0,$(TEST_HC_OPTS_INTERACTIVE)) \ -ghci-script T11389.script < /dev/null | grep 'configuration' + +.PHONY: T12023 +T12023: + -'$(TEST_HC)' $(TEST_HC_OPTS_INTERACTIVE) \ + -ghci-script T12023.script < /dev/null | grep -c -E '(~#|~R#|~P#)' diff --git a/testsuite/tests/ghci/scripts/T10059.script b/testsuite/tests/ghci/scripts/T10059.script new file mode 100644 index 0000000000..d352b9f15c --- /dev/null +++ b/testsuite/tests/ghci/scripts/T10059.script @@ -0,0 +1,5 @@ +:set -XTypeOperators +:i (~) +:k (~) +:set -fprint-equality-relations +:i (~) diff --git a/testsuite/tests/ghci/scripts/T10059.stdout b/testsuite/tests/ghci/scripts/T10059.stdout new file mode 100644 index 0000000000..92fbb45ef7 --- /dev/null +++ b/testsuite/tests/ghci/scripts/T10059.stdout @@ -0,0 +1,4 @@ +class (a ~ b) => (~) (a :: k0) (b :: k0) -- Defined in ‘GHC.Types’ +(~) :: k0 -> k0 -> Constraint +class (a GHC.Prim.~# b) => (~) (a :: k0) (b :: k0) + -- Defined in ‘GHC.Types’ diff --git a/testsuite/tests/ghci/scripts/T10248.stderr b/testsuite/tests/ghci/scripts/T10248.stderr index 9de7323928..b9cf45a8f6 100644 --- a/testsuite/tests/ghci/scripts/T10248.stderr +++ b/testsuite/tests/ghci/scripts/T10248.stderr @@ -1,10 +1,7 @@ <interactive>:2:10: error: • Found hole: _ :: f a - Where: ‘f’ is a rigid type variable bound by - the inferred type of it :: Functor f => f (Maybe a) - at <interactive>:2:1-10 - ‘a’ is a rigid type variable bound by + Where: ‘f’, ‘a’ are rigid type variables bound by the inferred type of it :: Functor f => f (Maybe a) at <interactive>:2:1-10 • In the second argument of ‘(<$>)’, namely ‘_’ @@ -12,3 +9,4 @@ In an equation for ‘it’: it = Just <$> _ • Relevant bindings include it :: f (Maybe a) (bound at <interactive>:2:1) + Constraints include Functor f (from <interactive>:2:1-10) diff --git a/testsuite/tests/ghci/scripts/T10249.stderr b/testsuite/tests/ghci/scripts/T10249.stderr index ade995051e..c8215663a5 100644 --- a/testsuite/tests/ghci/scripts/T10249.stderr +++ b/testsuite/tests/ghci/scripts/T10249.stderr @@ -2,7 +2,8 @@ <interactive>:1:1: error: • Found hole: _ :: t Where: ‘t’ is a rigid type variable bound by - the inferred type of it :: t at <interactive>:1:1 + the inferred type of it :: t + at <interactive>:1:1 • In the expression: _ In an equation for ‘it’: it = _ • Relevant bindings include it :: t (bound at <interactive>:1:1) diff --git a/testsuite/tests/ghci/scripts/T10321.hs b/testsuite/tests/ghci/scripts/T10321.hs index 44d264a801..443ebe41a4 100644 --- a/testsuite/tests/ghci/scripts/T10321.hs +++ b/testsuite/tests/ghci/scripts/T10321.hs @@ -5,9 +5,10 @@ module T10321 where +import Data.Kind (Type) import GHC.TypeLits -data Vec :: Nat -> * -> * where +data Vec :: Nat -> Type -> Type where Nil :: Vec 0 a (:>) :: a -> Vec n a -> Vec (n + 1) a diff --git a/testsuite/tests/ghci/scripts/T10963.script b/testsuite/tests/ghci/scripts/T10963.script index 357d1256ba..2bba5b36ef 100644 --- a/testsuite/tests/ghci/scripts/T10963.script +++ b/testsuite/tests/ghci/scripts/T10963.script @@ -3,5 +3,7 @@ :t +d length let foo :: (Num a, Monoid a) => a -> a; foo = undefined :t +d foo -instance Monoid Double where mempty = 0; mappend = (+) +import Data.Semigroup +instance Semigroup Double where (<>) = (+) +instance Monoid Double where mempty = 0 :t +d foo diff --git a/testsuite/tests/ghci/scripts/T10963.stderr b/testsuite/tests/ghci/scripts/T10963.stderr index e20f792773..2efd138be8 100644 --- a/testsuite/tests/ghci/scripts/T10963.stderr +++ b/testsuite/tests/ghci/scripts/T10963.stderr @@ -8,5 +8,5 @@ instance Num Double -- Defined in ‘GHC.Float’ instance Num Float -- Defined in ‘GHC.Float’ ...plus two others - ...plus five instances involving out-of-scope types + ...plus 8 instances involving out-of-scope types (use -fprint-potential-instances to see them all) diff --git a/testsuite/tests/ghci/scripts/T10963.stdout b/testsuite/tests/ghci/scripts/T10963.stdout index bf639a8aa5..415c473e47 100644 --- a/testsuite/tests/ghci/scripts/T10963.stdout +++ b/testsuite/tests/ghci/scripts/T10963.stdout @@ -1,4 +1,4 @@ -mapM :: (Monad m, Traversable t) => (a -> m b) -> t a -> m (t b) +mapM :: (Traversable t, Monad m) => (a -> m b) -> t a -> m (t b) mapM :: Monad m => (a -> m b) -> [a] -> m [b] length :: [a] -> Int foo :: Double -> Double diff --git a/testsuite/tests/ghci/scripts/T11252.script b/testsuite/tests/ghci/scripts/T11252.script index 485cd8fa0d..3cec1d348d 100644 --- a/testsuite/tests/ghci/scripts/T11252.script +++ b/testsuite/tests/ghci/scripts/T11252.script @@ -1,3 +1,3 @@ -:set -XTypeInType +:set -XPolyKinds data Proxy1 k (a :: k) = Proxy1 :kind Proxy1 diff --git a/testsuite/tests/ghci/scripts/T11252.stdout b/testsuite/tests/ghci/scripts/T11252.stdout index f6d45ddf32..eddba4530e 100644 --- a/testsuite/tests/ghci/scripts/T11252.stdout +++ b/testsuite/tests/ghci/scripts/T11252.stdout @@ -1 +1 @@ -Proxy1 :: k -> * +Proxy1 :: forall k -> k -> * diff --git a/testsuite/tests/ghci/scripts/T11376.script b/testsuite/tests/ghci/scripts/T11376.script index d359b66542..0cda4f02ba 100644 --- a/testsuite/tests/ghci/scripts/T11376.script +++ b/testsuite/tests/ghci/scripts/T11376.script @@ -3,7 +3,7 @@ let { bar :: Show a => a -> b -> a; bar = error "urk" } :type bar @Int :set -fprint-explicit-foralls :type bar @Int -:set -fprint-explicit-kinds -XTypeApplications -XTypeInType +:set -fprint-explicit-kinds -XTypeApplications -XPolyKinds data Prox a = Prox let { prox :: Prox a; prox = Prox } :t prox diff --git a/testsuite/tests/ghci/scripts/T11524a.stdout b/testsuite/tests/ghci/scripts/T11524a.stdout index 007d2ae097..ea91ef9cd1 100644 --- a/testsuite/tests/ghci/scripts/T11524a.stdout +++ b/testsuite/tests/ghci/scripts/T11524a.stdout @@ -4,15 +4,15 @@ pattern P :: Bool -- Defined at <interactive>:16:1 pattern Pe :: a -> Ex -- Defined at <interactive>:17:1 pattern Pu :: p -> p -- Defined at <interactive>:18:1 pattern Pue :: a -> a1 -> (a, Ex) -- Defined at <interactive>:19:1 -pattern Pur :: (Num a, Eq a) => a -> [a] +pattern Pur :: (Eq a, Num a) => a -> [a] -- Defined at <interactive>:20:1 -pattern Purp :: (Num a, Eq a) => Show a1 => a - -> a1 -> ([a], UnivProv a1) +pattern Purp + :: (Eq a, Num a) => Show a1 => a -> a1 -> ([a], UnivProv a1) -- Defined at <interactive>:21:1 -pattern Pure :: (Num a, Eq a) => a -> a1 -> ([a], Ex) +pattern Pure :: (Eq a, Num a) => a -> a1 -> ([a], Ex) -- Defined at <interactive>:22:1 -pattern Purep :: (Num a, Eq a) => Show a1 => a - -> a1 -> ([a], ExProv) +pattern Purep + :: (Eq a, Num a) => Show a1 => a -> a1 -> ([a], ExProv) -- Defined at <interactive>:23:1 pattern Pep :: () => Show a => a -> ExProv -- Defined at <interactive>:24:1 @@ -29,21 +29,28 @@ pattern Pe :: () => forall {a}. a -> Ex pattern Pu :: forall {p}. p -> p -- Defined at <interactive>:18:1 pattern Pue :: forall {a}. () => forall {a1}. a -> a1 -> (a, Ex) -- Defined at <interactive>:19:1 -pattern Pur :: forall {a}. (Num a, Eq a) => a -> [a] +pattern Pur :: forall {a}. (Eq a, Num a) => a -> [a] -- Defined at <interactive>:20:1 -pattern Purp :: forall {a} {a1}. (Num a, Eq a) => Show a1 => a - -> a1 -> ([a], UnivProv a1) +pattern Purp + :: forall {a} {a1}. + (Eq a, Num a) => + Show a1 => + a -> a1 -> ([a], UnivProv a1) -- Defined at <interactive>:21:1 -pattern Pure :: forall {a}. (Num a, Eq a) => forall {a1}. a - -> a1 -> ([a], Ex) +pattern Pure + :: forall {a}. (Eq a, Num a) => forall {a1}. a -> a1 -> ([a], Ex) -- Defined at <interactive>:22:1 -pattern Purep :: forall {a}. (Num a, Eq a) => forall {a1}. Show - a1 => a -> a1 -> ([a], ExProv) +pattern Purep + :: forall {a}. + (Eq a, Num a) => + forall {a1}. + Show a1 => + a -> a1 -> ([a], ExProv) -- Defined at <interactive>:23:1 pattern Pep :: () => forall {a}. Show a => a -> ExProv -- Defined at <interactive>:24:1 pattern Pup :: forall {a}. () => Show a => a -> UnivProv a -- Defined at <interactive>:25:1 -pattern Puep :: forall {b}. () => forall {a}. Show a => a - -> b -> (ExProv, b) +pattern Puep + :: forall {b}. () => forall {a}. Show a => a -> b -> (ExProv, b) -- Defined at <interactive>:26:1 diff --git a/testsuite/tests/ghci/scripts/T11547.script b/testsuite/tests/ghci/scripts/T11547.script deleted file mode 100644 index c4c15d6f78..0000000000 --- a/testsuite/tests/ghci/scripts/T11547.script +++ /dev/null @@ -1,9 +0,0 @@ -foo = foo -:t Ghci1.foo -foo = foo -:t Ghci2.foo -:t Ghci1.foo -data Foo = Foo | Bar -data Foo = Bar -:t Foo -:t Ghci3.Bar diff --git a/testsuite/tests/ghci/scripts/T11547.stdout b/testsuite/tests/ghci/scripts/T11547.stdout deleted file mode 100644 index 6f2a8333c3..0000000000 --- a/testsuite/tests/ghci/scripts/T11547.stdout +++ /dev/null @@ -1,5 +0,0 @@ -Ghci1.foo :: t -Ghci2.foo :: t -Ghci1.foo :: t -Foo :: Ghci3.Foo -Ghci3.Bar :: Ghci3.Foo diff --git a/testsuite/tests/ghci/scripts/T11721.script b/testsuite/tests/ghci/scripts/T11721.script new file mode 100644 index 0000000000..11fa313e3c --- /dev/null +++ b/testsuite/tests/ghci/scripts/T11721.script @@ -0,0 +1,7 @@ +:set -XGADTs -XPolyKinds -XTypeApplications +:set -fprint-explicit-foralls +import Data.Proxy +data X a where { MkX :: b -> Proxy a -> X a } +:type +v MkX +:type +v MkX @Int +:type +v MkX @Int @Maybe diff --git a/testsuite/tests/ghci/scripts/T11721.stdout b/testsuite/tests/ghci/scripts/T11721.stdout new file mode 100644 index 0000000000..145a5894dc --- /dev/null +++ b/testsuite/tests/ghci/scripts/T11721.stdout @@ -0,0 +1,3 @@ +MkX :: forall {k} b (a :: k). b -> Proxy a -> X a +MkX @Int :: forall {k} (a :: k). Int -> Proxy a -> X a +MkX @Int @Maybe :: Int -> Proxy Maybe -> X Maybe diff --git a/testsuite/tests/ghci/scripts/T11975.stdout b/testsuite/tests/ghci/scripts/T11975.stdout index 1a3dd4341a..56d8d4180d 100644 --- a/testsuite/tests/ghci/scripts/T11975.stdout +++ b/testsuite/tests/ghci/scripts/T11975.stdout @@ -1,15 +1,15 @@ mapM :: forall {t :: * -> *} {m :: * -> *} {a} {b}. - (Monad m, Traversable t) => + (Traversable t, Monad m) => (a -> m b) -> t a -> m (t b) mapM - :: forall (t :: * -> *). - Traversable t => - forall (m :: * -> *) a b. Monad m => (a -> m b) -> t a -> m (t b) + :: forall (t :: * -> *) (m :: * -> *) a b. + (Traversable t, Monad m) => + (a -> m b) -> t a -> m (t b) mapM - :: forall (t :: * -> *). - Traversable t => - forall (m :: * -> *) a b. Monad m => (a -> m b) -> t a -> m (t b) + :: forall (t :: * -> *) (m :: * -> *) a b. + (Traversable t, Monad m) => + (a -> m b) -> t a -> m (t b) foo @Int :: forall {b}. Num b => Int -> b foo @Int :: forall b. (Show Int, Num b) => Int -> b foo @Int :: forall b. (Show Int, Num b) => Int -> b diff --git a/testsuite/tests/ghci/scripts/T12023.script b/testsuite/tests/ghci/scripts/T12023.script new file mode 100644 index 0000000000..c7552fe4f8 --- /dev/null +++ b/testsuite/tests/ghci/scripts/T12023.script @@ -0,0 +1 @@ +:browse GHC.Prim diff --git a/testsuite/tests/ghci/scripts/T12023.stdout b/testsuite/tests/ghci/scripts/T12023.stdout new file mode 100644 index 0000000000..573541ac97 --- /dev/null +++ b/testsuite/tests/ghci/scripts/T12023.stdout @@ -0,0 +1 @@ +0 diff --git a/testsuite/tests/ghci/scripts/T12158.script b/testsuite/tests/ghci/scripts/T12158.script new file mode 100644 index 0000000000..d18f360513 --- /dev/null +++ b/testsuite/tests/ghci/scripts/T12158.script @@ -0,0 +1,2 @@ +data Stock = Stock {name :: String, ric :: String, price :: Float} deriving (Show) +price Stock{name=name,ric=ric,price=price} = price diff --git a/testsuite/tests/ghci/scripts/T12447.stdout b/testsuite/tests/ghci/scripts/T12447.stdout index 67bbc9bcc7..6c469eeef3 100644 --- a/testsuite/tests/ghci/scripts/T12447.stdout +++ b/testsuite/tests/ghci/scripts/T12447.stdout @@ -1,3 +1,3 @@ deferEither @(_ ~ _) - :: Deferrable (w2 ~ w1) => - proxy (w2 ~ w1) -> (w2 ~ w1 => r) -> Either String r + :: (Typeable w1, Typeable w2) => + proxy (w1 ~ w2) -> ((w1 ~ w2) => r) -> Either String r diff --git a/testsuite/tests/ghci/scripts/T12550.script b/testsuite/tests/ghci/scripts/T12550.script index dad2a47e65..7c07e8f1dd 100644 --- a/testsuite/tests/ghci/scripts/T12550.script +++ b/testsuite/tests/ghci/scripts/T12550.script @@ -1,4 +1,4 @@ -:set -fprint-explicit-foralls -XKindSignatures -XExplicitNamespaces +:set -fprint-explicit-foralls -XKindSignatures -XExplicitNamespaces -XUnicodeSyntax import Data.Kind (type Type) diff --git a/testsuite/tests/ghci/scripts/T12550.stdout b/testsuite/tests/ghci/scripts/T12550.stdout index d4ac6b86fb..0955db3787 100644 --- a/testsuite/tests/ghci/scripts/T12550.stdout +++ b/testsuite/tests/ghci/scripts/T12550.stdout @@ -35,15 +35,15 @@ instance ∀ i (c ∷ Meta) (f ∷ ★ → ★). Functor f ⇒ Functor (M1 i c f -- Defined in ‘GHC.Generics’ instance ∀ i c. Functor (K1 i c) -- Defined in ‘GHC.Generics’ instance ∀ (f ∷ ★ → ★) (g ∷ ★ → ★). - (Functor g, Functor f) ⇒ + (Functor f, Functor g) ⇒ Functor (f :.: g) -- Defined in ‘GHC.Generics’ instance ∀ (f ∷ ★ → ★) (g ∷ ★ → ★). - (Functor g, Functor f) ⇒ + (Functor f, Functor g) ⇒ Functor (f :+: g) -- Defined in ‘GHC.Generics’ instance ∀ (f ∷ ★ → ★) (g ∷ ★ → ★). - (Functor g, Functor f) ⇒ + (Functor f, Functor g) ⇒ Functor (f :*: g) -- Defined in ‘GHC.Generics’ instance ∀ a. Functor (Either a) -- Defined in ‘Data.Either’ diff --git a/testsuite/tests/ghci/scripts/T13407.script b/testsuite/tests/ghci/scripts/T13407.script new file mode 100644 index 0000000000..3956a3a210 --- /dev/null +++ b/testsuite/tests/ghci/scripts/T13407.script @@ -0,0 +1,4 @@ +:set -XPolyKinds -XRankNTypes +import Data.Kind +data Foo :: (Type -> Type) -> (forall k. k -> Type) +:info Foo diff --git a/testsuite/tests/ghci/scripts/T13407.stdout b/testsuite/tests/ghci/scripts/T13407.stdout new file mode 100644 index 0000000000..083f3a8b1f --- /dev/null +++ b/testsuite/tests/ghci/scripts/T13407.stdout @@ -0,0 +1,3 @@ +type role Foo phantom phantom +data Foo (a :: * -> *) (b :: k) + -- Defined at <interactive>:3:1 diff --git a/testsuite/tests/ghci/scripts/T13963.script b/testsuite/tests/ghci/scripts/T13963.script new file mode 100644 index 0000000000..c5e830aad1 --- /dev/null +++ b/testsuite/tests/ghci/scripts/T13963.script @@ -0,0 +1,13 @@ +:set -XPolyKinds -XDataKinds -XRankNTypes +import GHC.Exts (TYPE, RuntimeRep(LiftedRep)) +type Pair (a :: TYPE rep) (b :: TYPE rep') rep'' = forall (r :: TYPE rep''). (a -> b -> r) +:kind Pair +:kind Pair Int +:kind Pair Int Float +:kind Pair Int Float LiftedRep + +:set -fprint-explicit-runtime-reps +:kind Pair +:kind Pair Int +:kind Pair Int Float +:kind Pair Int Float LiftedRep diff --git a/testsuite/tests/ghci/scripts/T13963.stdout b/testsuite/tests/ghci/scripts/T13963.stdout new file mode 100644 index 0000000000..52026af489 --- /dev/null +++ b/testsuite/tests/ghci/scripts/T13963.stdout @@ -0,0 +1,8 @@ +Pair :: * -> * -> RuntimeRep -> * +Pair Int :: * -> RuntimeRep -> * +Pair Int Float :: RuntimeRep -> * +Pair Int Float LiftedRep :: * +Pair :: TYPE rep -> TYPE rep' -> RuntimeRep -> * +Pair Int :: * -> RuntimeRep -> * +Pair Int Float :: RuntimeRep -> * +Pair Int Float LiftedRep :: * diff --git a/testsuite/tests/ghci/scripts/T13988.hs b/testsuite/tests/ghci/scripts/T13988.hs new file mode 100644 index 0000000000..d26135e26d --- /dev/null +++ b/testsuite/tests/ghci/scripts/T13988.hs @@ -0,0 +1,8 @@ +{-# LANGUAGE PolyKinds, GADTs #-} + +module T13988 where + +import Data.Kind + +data Foo (a :: k) where + MkFoo :: (k ~ Type) => Foo (a :: k) diff --git a/testsuite/tests/ghci/scripts/T13988.script b/testsuite/tests/ghci/scripts/T13988.script new file mode 100644 index 0000000000..06aa686ed5 --- /dev/null +++ b/testsuite/tests/ghci/scripts/T13988.script @@ -0,0 +1,2 @@ +:load T13988 +:type +v MkFoo diff --git a/testsuite/tests/ghci/scripts/T13988.stdout b/testsuite/tests/ghci/scripts/T13988.stdout new file mode 100644 index 0000000000..a89ff3331d --- /dev/null +++ b/testsuite/tests/ghci/scripts/T13988.stdout @@ -0,0 +1 @@ +MkFoo :: forall k (a :: k). (k ~ *) => Foo a diff --git a/testsuite/tests/ghci/scripts/T14342.script b/testsuite/tests/ghci/scripts/T14342.script new file mode 100644 index 0000000000..e69de29bb2 --- /dev/null +++ b/testsuite/tests/ghci/scripts/T14342.script diff --git a/testsuite/tests/ghci/scripts/T14676.script b/testsuite/tests/ghci/scripts/T14676.script new file mode 100644 index 0000000000..9cfe6934fe --- /dev/null +++ b/testsuite/tests/ghci/scripts/T14676.script @@ -0,0 +1,7 @@ +:add Notfound.hs +:add NotFound +:show targets +:add prog002/A1.hs +:show targets +:unadd prog002/A1.hs +:show targets diff --git a/testsuite/tests/ghci/scripts/T14676.stdout b/testsuite/tests/ghci/scripts/T14676.stdout new file mode 100644 index 0000000000..c3e9fbd6b4 --- /dev/null +++ b/testsuite/tests/ghci/scripts/T14676.stdout @@ -0,0 +1,3 @@ +File Notfound.hs not found +Module NotFound not found +prog002/A1.hs diff --git a/testsuite/tests/ghci/scripts/T14796.script b/testsuite/tests/ghci/scripts/T14796.script new file mode 100644 index 0000000000..9a85d440ef --- /dev/null +++ b/testsuite/tests/ghci/scripts/T14796.script @@ -0,0 +1,3 @@ +:set -XGADTs -XConstraintKinds -XTypeApplications +data ECC ctx f a where ECC :: ctx => f a -> ECC ctx f a +:t ECC @() @[] @() diff --git a/testsuite/tests/ghci/scripts/T14796.stdout b/testsuite/tests/ghci/scripts/T14796.stdout new file mode 100644 index 0000000000..c8bb21936a --- /dev/null +++ b/testsuite/tests/ghci/scripts/T14796.stdout @@ -0,0 +1 @@ +ECC @() @[] @() :: [()] -> ECC (() :: Constraint) [] () diff --git a/testsuite/tests/ghci/scripts/T14969.script b/testsuite/tests/ghci/scripts/T14969.script new file mode 100644 index 0000000000..ab6af53c6b --- /dev/null +++ b/testsuite/tests/ghci/scripts/T14969.script @@ -0,0 +1 @@ +3 _ 4 diff --git a/testsuite/tests/ghci/scripts/T14969.stderr b/testsuite/tests/ghci/scripts/T14969.stderr new file mode 100644 index 0000000000..b581657d3c --- /dev/null +++ b/testsuite/tests/ghci/scripts/T14969.stderr @@ -0,0 +1,7 @@ + +<interactive>:1:1: error: + • Non type-variable argument + in the constraint: Num (t2 -> t1 -> t3) + (Use FlexibleContexts to permit this) + • When checking the inferred type + it :: forall t1 t2 t3. (Num t1, Num (t2 -> t1 -> t3)) => t3 diff --git a/testsuite/tests/ghci/scripts/T15259.script b/testsuite/tests/ghci/scripts/T15259.script new file mode 100644 index 0000000000..a2750c3a08 --- /dev/null +++ b/testsuite/tests/ghci/scripts/T15259.script @@ -0,0 +1,3 @@ +:set -fdefer-out-of-scope-variables + +1 + a diff --git a/testsuite/tests/ghci/scripts/T15259.stderr b/testsuite/tests/ghci/scripts/T15259.stderr new file mode 100644 index 0000000000..29a04a6487 --- /dev/null +++ b/testsuite/tests/ghci/scripts/T15259.stderr @@ -0,0 +1,2 @@ + +<interactive>:3:5: error: Variable not in scope: a diff --git a/testsuite/tests/ghci/scripts/T15325.hs b/testsuite/tests/ghci/scripts/T15325.hs new file mode 100644 index 0000000000..3a0407bfcb --- /dev/null +++ b/testsuite/tests/ghci/scripts/T15325.hs @@ -0,0 +1,11 @@ +{-# OPTIONS_GHC -fdefer-type-errors #-} +module T15325 where + +class PolyList e where + polyList :: e -> () + +f :: PolyList e => e -> () +f x = polyList x + +plh :: () +plh = f 0 diff --git a/testsuite/tests/ghci/scripts/T15325.script b/testsuite/tests/ghci/scripts/T15325.script new file mode 100644 index 0000000000..227c00ce66 --- /dev/null +++ b/testsuite/tests/ghci/scripts/T15325.script @@ -0,0 +1,2 @@ +:l T15325 +plh diff --git a/testsuite/tests/ghci/scripts/T15325.stderr b/testsuite/tests/ghci/scripts/T15325.stderr new file mode 100644 index 0000000000..c767528e2c --- /dev/null +++ b/testsuite/tests/ghci/scripts/T15325.stderr @@ -0,0 +1,25 @@ + +T15325.hs:11:7: warning: [-Wdeferred-type-errors (in -Wdefault)] + • No instance for (PolyList e0) arising from a use of ‘f’ + • In the expression: f 0 + In an equation for ‘plh’: plh = f 0 + +T15325.hs:11:9: warning: [-Wdeferred-type-errors (in -Wdefault)] + • Ambiguous type variable ‘e0’ arising from the literal ‘0’ + prevents the constraint ‘(Num e0)’ from being solved. + Probable fix: use a type annotation to specify what ‘e0’ should be. + These potential instances exist: + instance Num Integer -- Defined in ‘GHC.Num’ + instance Num Double -- Defined in ‘GHC.Float’ + instance Num Float -- Defined in ‘GHC.Float’ + ...plus two others + ...plus one instance involving out-of-scope types + (use -fprint-potential-instances to see them all) + • In the first argument of ‘f’, namely ‘0’ + In the expression: f 0 + In an equation for ‘plh’: plh = f 0 +*** Exception: T15325.hs:11:7: error: + • No instance for (PolyList e0) arising from a use of ‘f’ + • In the expression: f 0 + In an equation for ‘plh’: plh = f 0 +(deferred type error) diff --git a/testsuite/tests/ghci/scripts/T15341.hs b/testsuite/tests/ghci/scripts/T15341.hs new file mode 100644 index 0000000000..b84c1bbe10 --- /dev/null +++ b/testsuite/tests/ghci/scripts/T15341.hs @@ -0,0 +1,6 @@ +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE TypeFamilies #-} +module T15341 where + +type family Foo (a :: k) :: k where + Foo a = a diff --git a/testsuite/tests/ghci/scripts/T15341.script b/testsuite/tests/ghci/scripts/T15341.script new file mode 100644 index 0000000000..0a3ffdc5d3 --- /dev/null +++ b/testsuite/tests/ghci/scripts/T15341.script @@ -0,0 +1,4 @@ +:load T15341.hs +:info Foo +:set -fprint-explicit-kinds +:info Foo diff --git a/testsuite/tests/ghci/scripts/T15341.stdout b/testsuite/tests/ghci/scripts/T15341.stdout new file mode 100644 index 0000000000..1d29dc7f8f --- /dev/null +++ b/testsuite/tests/ghci/scripts/T15341.stdout @@ -0,0 +1,6 @@ +type family Foo (a :: k) :: k + where Foo a = a + -- Defined at T15341.hs:5:1 +type family Foo k (a :: k) :: k + where Foo k a = a + -- Defined at T15341.hs:5:1 diff --git a/testsuite/tests/ghci/scripts/T15568.hs b/testsuite/tests/ghci/scripts/T15568.hs new file mode 100644 index 0000000000..2172fe2694 --- /dev/null +++ b/testsuite/tests/ghci/scripts/T15568.hs @@ -0,0 +1,7 @@ +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE TypeFamilies #-} +module T15568 where + +import Data.Proxy + +type family F (a :: j) :: k diff --git a/testsuite/tests/ghci/scripts/T15568.script b/testsuite/tests/ghci/scripts/T15568.script new file mode 100644 index 0000000000..8218ccc7fd --- /dev/null +++ b/testsuite/tests/ghci/scripts/T15568.script @@ -0,0 +1,4 @@ +:load T15568 +:set -fprint-explicit-foralls +putStrLn "-- This should print 'forall j k.', not 'forall k j.'" +:kind F diff --git a/testsuite/tests/ghci/scripts/T15568.stdout b/testsuite/tests/ghci/scripts/T15568.stdout new file mode 100644 index 0000000000..e97cc6b040 --- /dev/null +++ b/testsuite/tests/ghci/scripts/T15568.stdout @@ -0,0 +1,2 @@ +-- This should print 'forall j k.', not 'forall k j.' +F :: forall j k. j -> k diff --git a/testsuite/tests/ghci/scripts/T1914.stdout b/testsuite/tests/ghci/scripts/T1914.stdout index 2d1a82b275..6612564354 100644 --- a/testsuite/tests/ghci/scripts/T1914.stdout +++ b/testsuite/tests/ghci/scripts/T1914.stdout @@ -1,7 +1,7 @@ [1 of 2] Compiling T1914B ( T1914B.hs, interpreted ) [2 of 2] Compiling T1914A ( T1914A.hs, interpreted ) -Ok, 2 modules loaded. +Ok, two modules loaded. [2 of 2] Compiling T1914A ( T1914A.hs, interpreted ) -Failed, 1 module loaded. +Failed, one module loaded. [2 of 2] Compiling T1914A ( T1914A.hs, interpreted ) -Ok, 2 modules loaded. +Ok, two modules loaded. diff --git a/testsuite/tests/ghci/scripts/T2976.stdout b/testsuite/tests/ghci/scripts/T2976.stdout index de31112bb3..9fdc11072c 100644 --- a/testsuite/tests/ghci/scripts/T2976.stdout +++ b/testsuite/tests/ghci/scripts/T2976.stdout @@ -1,8 +1,6 @@ test :: Integer = 0 test = 0 test :: Integer = 0 -Ghci1.test :: Integer = 0 test :: [Char] = _ test = "test" -Ghci1.test :: Integer = 0 test :: [Char] = "test" diff --git a/testsuite/tests/ghci/scripts/T4175.stdout b/testsuite/tests/ghci/scripts/T4175.stdout index 6f56a5f868..75d6c27506 100644 --- a/testsuite/tests/ghci/scripts/T4175.stdout +++ b/testsuite/tests/ghci/scripts/T4175.stdout @@ -21,6 +21,7 @@ instance C () -- Defined at T4175.hs:21:10 instance Eq () -- Defined in ‘GHC.Classes’ instance Monoid () -- Defined in ‘GHC.Base’ instance Ord () -- Defined in ‘GHC.Classes’ +instance Semigroup () -- Defined in ‘GHC.Base’ instance Show () -- Defined in ‘GHC.Show’ instance Read () -- Defined in ‘GHC.Read’ instance Enum () -- Defined in ‘GHC.Enum’ @@ -28,13 +29,15 @@ instance Bounded () -- Defined in ‘GHC.Enum’ type instance D () () = Bool -- Defined at T4175.hs:22:10 type instance D Int () = String -- Defined at T4175.hs:19:10 data instance B () = MkB -- Defined at T4175.hs:13:15 -data Maybe a = Nothing | Just a -- Defined in ‘GHC.Base’ +data Maybe a = Nothing | Just a -- Defined in ‘GHC.Maybe’ instance Applicative Maybe -- Defined in ‘GHC.Base’ -instance Eq a => Eq (Maybe a) -- Defined in ‘GHC.Base’ +instance Eq a => Eq (Maybe a) -- Defined in ‘GHC.Maybe’ instance Functor Maybe -- Defined in ‘GHC.Base’ instance Monad Maybe -- Defined in ‘GHC.Base’ -instance Monoid a => Monoid (Maybe a) -- Defined in ‘GHC.Base’ -instance Ord a => Ord (Maybe a) -- Defined in ‘GHC.Base’ +instance Semigroup a => Monoid (Maybe a) -- Defined in ‘GHC.Base’ +instance Ord a => Ord (Maybe a) -- Defined in ‘GHC.Maybe’ +instance Semigroup a => Semigroup (Maybe a) + -- Defined in ‘GHC.Base’ instance Show a => Show (Maybe a) -- Defined in ‘GHC.Show’ instance Read a => Read (Maybe a) -- Defined in ‘GHC.Read’ instance Foldable Maybe -- Defined in ‘Data.Foldable’ diff --git a/testsuite/tests/ghci/scripts/T6105.stdout b/testsuite/tests/ghci/scripts/T6105.stdout index 6a846e3f21..9a8190f26c 100644 --- a/testsuite/tests/ghci/scripts/T6105.stdout +++ b/testsuite/tests/ghci/scripts/T6105.stdout @@ -1,4 +1,4 @@ [1 of 1] Compiling T6105 ( T6105.hs, interpreted ) -Ok, 1 module loaded. +Ok, one module loaded. [1 of 1] Compiling T6105 ( T6105.hs, interpreted ) -Ok, 1 module loaded. +Ok, one module loaded. diff --git a/testsuite/tests/ghci/scripts/T7627.stdout b/testsuite/tests/ghci/scripts/T7627.stdout index c13a3f3ba0..8bf93a0d0f 100644 --- a/testsuite/tests/ghci/scripts/T7627.stdout +++ b/testsuite/tests/ghci/scripts/T7627.stdout @@ -2,11 +2,13 @@ data () = () -- Defined in ‘GHC.Tuple’ instance Eq () -- Defined in ‘GHC.Classes’ instance Monoid () -- Defined in ‘GHC.Base’ instance Ord () -- Defined in ‘GHC.Classes’ +instance Semigroup () -- Defined in ‘GHC.Base’ instance Show () -- Defined in ‘GHC.Show’ instance Read () -- Defined in ‘GHC.Read’ instance Enum () -- Defined in ‘GHC.Enum’ instance Bounded () -- Defined in ‘GHC.Enum’ -data (##) = (##) -- Defined in ‘GHC.Prim’ +data (##) :: TYPE ('GHC.Types.TupleRep '[]) = (##) + -- Defined in ‘GHC.Prim’ () :: () (##) :: (# #) ( ) :: () @@ -19,13 +21,17 @@ instance Monoid a => Monad ((,) a) -- Defined in ‘GHC.Base’ instance (Monoid a, Monoid b) => Monoid (a, b) -- Defined in ‘GHC.Base’ instance (Ord a, Ord b) => Ord (a, b) -- Defined in ‘GHC.Classes’ +instance (Semigroup a, Semigroup b) => Semigroup (a, b) + -- Defined in ‘GHC.Base’ instance (Show a, Show b) => Show (a, b) -- Defined in ‘GHC.Show’ instance (Read a, Read b) => Read (a, b) -- Defined in ‘GHC.Read’ instance Foldable ((,) a) -- Defined in ‘Data.Foldable’ instance Traversable ((,) a) -- Defined in ‘Data.Traversable’ instance (Bounded a, Bounded b) => Bounded (a, b) -- Defined in ‘GHC.Enum’ -data (#,#) (a :: TYPE k0) (b :: TYPE k1) = (#,#) a b +data (#,#) (a :: TYPE k0) (b :: TYPE k1) :: TYPE + ('GHC.Types.TupleRep '[k0, k1]) + = (#,#) a b -- Defined in ‘GHC.Prim’ (,) :: a -> b -> (a, b) (#,#) :: a -> b -> (# a, b #) diff --git a/testsuite/tests/ghci/scripts/T7730.stdout b/testsuite/tests/ghci/scripts/T7730.stdout index e96e909413..bf9c1d025b 100644 --- a/testsuite/tests/ghci/scripts/T7730.stdout +++ b/testsuite/tests/ghci/scripts/T7730.stdout @@ -3,6 +3,5 @@ data A (x :: k) (y :: k1) -- Defined at <interactive>:2:1 A :: k1 -> k2 -> * type role T phantom -data T (a :: k) where - MkT :: forall k (a :: k) a1. a1 -> T a +data T (a :: k) = forall a1. MkT a1 -- Defined at <interactive>:6:1 diff --git a/testsuite/tests/ghci/scripts/T7873.script b/testsuite/tests/ghci/scripts/T7873.script index 404c1f5bda..1a358a478e 100644 --- a/testsuite/tests/ghci/scripts/T7873.script +++ b/testsuite/tests/ghci/scripts/T7873.script @@ -1,4 +1,4 @@ -:set -XPolyKinds -XRankNTypes -XGADTs -XTypeInType +:set -XPolyKinds -XRankNTypes -XGADTs data D1 = MkD1 (forall p (a :: k). p a -> Int) data D2 = MkD2 (forall p a. p a -> Int) data D3 = MkD3 (forall k p (a :: k). p a -> Int) diff --git a/testsuite/tests/ghci/scripts/T7873.stderr b/testsuite/tests/ghci/scripts/T7873.stderr index c218cff153..731a216a1a 100644 --- a/testsuite/tests/ghci/scripts/T7873.stderr +++ b/testsuite/tests/ghci/scripts/T7873.stderr @@ -1,6 +1,8 @@ <interactive>:2:1: error: - Kind variable ‘k’ is implicitly bound in data type - ‘D1’, but does not appear as the kind of any - of its type variables. Perhaps you meant - to bind it explicitly somewhere? + • Kind variable ‘k’ is implicitly bound in data type + ‘D1’, but does not appear as the kind of any + of its type variables. Perhaps you meant + to bind it explicitly somewhere? + Type variables with inferred kinds: (k :: *) + • In the data declaration for ‘D1’ diff --git a/testsuite/tests/ghci/scripts/T7873.stdout b/testsuite/tests/ghci/scripts/T7873.stdout index 2c79056da4..bcdebe71e1 100644 --- a/testsuite/tests/ghci/scripts/T7873.stdout +++ b/testsuite/tests/ghci/scripts/T7873.stdout @@ -1,5 +1,5 @@ -data D2 where - MkD2 :: (forall (p :: k -> *) (a :: k). p a -> Int) -> D2 +data D2 + = forall k. MkD2 (forall (p :: k -> *) (a :: k). p a -> Int) -- Defined at <interactive>:3:1 data D3 = MkD3 (forall k (p :: k -> *) (a :: k). p a -> Int) -- Defined at <interactive>:4:1 diff --git a/testsuite/tests/ghci/scripts/T7939.hs b/testsuite/tests/ghci/scripts/T7939.hs index fbdf883b51..04a1f1a623 100644 --- a/testsuite/tests/ghci/scripts/T7939.hs +++ b/testsuite/tests/ghci/scripts/T7939.hs @@ -1,6 +1,6 @@ {-# LANGUAGE TypeFamilies, PolyKinds, DataKinds, TypeOperators #-} - module T7939 where +import Data.Kind (Type) class Foo a where type Bar a b @@ -22,6 +22,6 @@ type family K a where K '[] = Nothing K (h ': t) = Just h -type family L (a :: k) (b :: *) :: k where +type family L (a :: k) (b :: Type) :: k where L Int Int = Bool L Maybe Bool = IO diff --git a/testsuite/tests/ghci/scripts/T7939.stdout b/testsuite/tests/ghci/scripts/T7939.stdout index db2590c930..82a8658906 100644 --- a/testsuite/tests/ghci/scripts/T7939.stdout +++ b/testsuite/tests/ghci/scripts/T7939.stdout @@ -15,13 +15,13 @@ type family H (a :: Bool) :: Bool H :: Bool -> Bool type family J (a :: [k]) :: Bool where - J k '[] = 'False - J k (h : t) = 'True + J '[] = 'False + J (h : t) = 'True -- Defined at T7939.hs:17:1 J :: [k] -> Bool type family K (a1 :: [a]) :: Maybe a where - K a '[] = 'Nothing - K a (h : t) = 'Just h + K '[] = 'Nothing + K (h : t) = 'Just h -- Defined at T7939.hs:21:1 K :: [a] -> Maybe a diff --git a/testsuite/tests/ghci/scripts/T8353.stderr b/testsuite/tests/ghci/scripts/T8353.stderr index 863a64fc4e..a84b0b7e83 100644 --- a/testsuite/tests/ghci/scripts/T8353.stderr +++ b/testsuite/tests/ghci/scripts/T8353.stderr @@ -9,7 +9,17 @@ Defer03.hs:7:5: warning: [-Wtyped-holes (in -Wdefault)] • In the expression: _ In an equation for ‘f’: f = _ • Relevant bindings include f :: Int (bound at Defer03.hs:7:1) - Valid substitutions include a :: Int (defined at Defer03.hs:4:1) + Valid hole fits include + f :: Int (bound at Defer03.hs:7:1) + a :: Int (defined at Defer03.hs:4:1) + maxBound :: forall a. Bounded a => a + with maxBound @Int + (imported from ‘Prelude’ at Defer03.hs:1:8-11 + (and originally defined in ‘GHC.Enum’)) + minBound :: forall a. Bounded a => a + with minBound @Int + (imported from ‘Prelude’ at Defer03.hs:1:8-11 + (and originally defined in ‘GHC.Enum’)) Defer03.hs:4:5: error: • Couldn't match expected type ‘Int’ with actual type ‘Char’ @@ -21,7 +31,17 @@ Defer03.hs:7:5: error: • In the expression: _ In an equation for ‘f’: f = _ • Relevant bindings include f :: Int (bound at Defer03.hs:7:1) - Valid substitutions include a :: Int (defined at Defer03.hs:4:1) + Valid hole fits include + f :: Int (bound at Defer03.hs:7:1) + a :: Int (defined at Defer03.hs:4:1) + maxBound :: forall a. Bounded a => a + with maxBound @Int + (imported from ‘Prelude’ at Defer03.hs:1:8-11 + (and originally defined in ‘GHC.Enum’)) + minBound :: forall a. Bounded a => a + with minBound @Int + (imported from ‘Prelude’ at Defer03.hs:1:8-11 + (and originally defined in ‘GHC.Enum’)) Defer03.hs:4:5: warning: [-Wdeferred-type-errors (in -Wdefault)] • Couldn't match expected type ‘Int’ with actual type ‘Char’ @@ -33,7 +53,17 @@ Defer03.hs:7:5: warning: [-Wtyped-holes (in -Wdefault)] • In the expression: _ In an equation for ‘f’: f = _ • Relevant bindings include f :: Int (bound at Defer03.hs:7:1) - Valid substitutions include a :: Int (defined at Defer03.hs:4:1) + Valid hole fits include + f :: Int (bound at Defer03.hs:7:1) + a :: Int (defined at Defer03.hs:4:1) + maxBound :: forall a. Bounded a => a + with maxBound @Int + (imported from ‘Prelude’ at Defer03.hs:1:8-11 + (and originally defined in ‘GHC.Enum’)) + minBound :: forall a. Bounded a => a + with minBound @Int + (imported from ‘Prelude’ at Defer03.hs:1:8-11 + (and originally defined in ‘GHC.Enum’)) Defer03.hs:4:5: error: • Couldn't match expected type ‘Int’ with actual type ‘Char’ @@ -45,7 +75,17 @@ Defer03.hs:7:5: error: • In the expression: _ In an equation for ‘f’: f = _ • Relevant bindings include f :: Int (bound at Defer03.hs:7:1) - Valid substitutions include a :: Int (defined at Defer03.hs:4:1) + Valid hole fits include + f :: Int (bound at Defer03.hs:7:1) + a :: Int (defined at Defer03.hs:4:1) + maxBound :: forall a. Bounded a => a + with maxBound @Int + (imported from ‘Prelude’ at Defer03.hs:1:8-11 + (and originally defined in ‘GHC.Enum’)) + minBound :: forall a. Bounded a => a + with minBound @Int + (imported from ‘Prelude’ at Defer03.hs:1:8-11 + (and originally defined in ‘GHC.Enum’)) Defer03.hs:4:5: warning: [-Wdeferred-type-errors (in -Wdefault)] • Couldn't match expected type ‘Int’ with actual type ‘Char’ @@ -57,4 +97,14 @@ Defer03.hs:7:5: warning: [-Wtyped-holes (in -Wdefault)] • In the expression: _ In an equation for ‘f’: f = _ • Relevant bindings include f :: Int (bound at Defer03.hs:7:1) - Valid substitutions include a :: Int (defined at Defer03.hs:4:1) + Valid hole fits include + f :: Int (bound at Defer03.hs:7:1) + a :: Int (defined at Defer03.hs:4:1) + maxBound :: forall a. Bounded a => a + with maxBound @Int + (imported from ‘Prelude’ at Defer03.hs:1:8-11 + (and originally defined in ‘GHC.Enum’)) + minBound :: forall a. Bounded a => a + with minBound @Int + (imported from ‘Prelude’ at Defer03.hs:1:8-11 + (and originally defined in ‘GHC.Enum’)) diff --git a/testsuite/tests/ghci/scripts/T8357.hs b/testsuite/tests/ghci/scripts/T8357.hs index 82a34afdc6..322ec11e19 100644 --- a/testsuite/tests/ghci/scripts/T8357.hs +++ b/testsuite/tests/ghci/scripts/T8357.hs @@ -5,11 +5,12 @@ {-# LANGUAGE TypeOperators #-} module T8357 where +import Data.Kind (Type) import GHC.TypeLits data (:::) (sy :: Symbol) ty data Key (sy :: Symbol) -data Rec (rs :: [*]) +data Rec (rs :: [Type]) (*=) :: Key sy -> ty -> Rec '[sy ::: ty] (*=) = undefined @@ -17,7 +18,7 @@ data Rec (rs :: [*]) (.*.) :: (Union xs ys ~ rs) => Rec xs -> Rec ys -> Rec rs (.*.) = undefined -type family Union (xs :: [*]) (ys :: [*]) :: [*] where +type family Union (xs :: [Type]) (ys :: [Type]) :: [Type] where Union ((sy ::: t) ': xs) ys = (sy ::: t) ': Union xs ys Union '[] ys = ys @@ -30,4 +31,4 @@ fBar = undefined foo = fFoo *= "foo" bar = fBar *= "bar" -both = foo .*. bar
\ No newline at end of file +both = foo .*. bar diff --git a/testsuite/tests/ghci/scripts/T8535.stdout b/testsuite/tests/ghci/scripts/T8535.stdout index 3995bc0b20..6ae0c4ccfe 100644 --- a/testsuite/tests/ghci/scripts/T8535.stdout +++ b/testsuite/tests/ghci/scripts/T8535.stdout @@ -1,6 +1,7 @@ data (->) (a :: TYPE q) (b :: TYPE r) -- Defined in ‘GHC.Prim’ -infixr 0 `(->)` +infixr 0 -> instance Applicative ((->) a) -- Defined in ‘GHC.Base’ instance Functor ((->) r) -- Defined in ‘GHC.Base’ instance Monad ((->) r) -- Defined in ‘GHC.Base’ instance Monoid b => Monoid (a -> b) -- Defined in ‘GHC.Base’ +instance Semigroup b => Semigroup (a -> b) -- Defined in ‘GHC.Base’ diff --git a/testsuite/tests/ghci/scripts/T9181.stdout b/testsuite/tests/ghci/scripts/T9181.stdout index d51b345d5c..5e520fb0a2 100644 --- a/testsuite/tests/ghci/scripts/T9181.stdout +++ b/testsuite/tests/ghci/scripts/T9181.stdout @@ -4,19 +4,22 @@ type family GHC.TypeLits.AppendSymbol (a :: GHC.Types.Symbol) type family GHC.TypeLits.CmpSymbol (a :: GHC.Types.Symbol) (b :: GHC.Types.Symbol) :: Ordering -data GHC.TypeLits.ErrorMessage where - GHC.TypeLits.Text :: GHC.Types.Symbol -> GHC.TypeLits.ErrorMessage - GHC.TypeLits.ShowType :: t -> GHC.TypeLits.ErrorMessage - (GHC.TypeLits.:<>:) :: GHC.TypeLits.ErrorMessage - -> GHC.TypeLits.ErrorMessage -> GHC.TypeLits.ErrorMessage - (GHC.TypeLits.:$$:) :: GHC.TypeLits.ErrorMessage - -> GHC.TypeLits.ErrorMessage -> GHC.TypeLits.ErrorMessage +data GHC.TypeLits.ErrorMessage + = GHC.TypeLits.Text GHC.Types.Symbol + | forall t. GHC.TypeLits.ShowType t + | GHC.TypeLits.ErrorMessage + GHC.TypeLits.:<>: + GHC.TypeLits.ErrorMessage + | GHC.TypeLits.ErrorMessage + GHC.TypeLits.:$$: + GHC.TypeLits.ErrorMessage class GHC.TypeLits.KnownSymbol (n :: GHC.Types.Symbol) where GHC.TypeLits.symbolSing :: GHC.TypeLits.SSymbol n {-# MINIMAL symbolSing #-} -data GHC.TypeLits.SomeSymbol where - GHC.TypeLits.SomeSymbol :: GHC.TypeLits.KnownSymbol n => - (Data.Proxy.Proxy n) -> GHC.TypeLits.SomeSymbol +data GHC.TypeLits.SomeSymbol + = forall (n :: GHC.Types.Symbol). + GHC.TypeLits.KnownSymbol n => + GHC.TypeLits.SomeSymbol (Data.Proxy.Proxy n) type family GHC.TypeLits.TypeError (a :: GHC.TypeLits.ErrorMessage) :: b GHC.TypeLits.natVal :: @@ -50,13 +53,21 @@ type family (GHC.TypeNats.<=?) (a :: GHC.Types.Nat) type family GHC.TypeNats.CmpNat (a :: GHC.Types.Nat) (b :: GHC.Types.Nat) :: Ordering +type family GHC.TypeNats.Div (a :: GHC.Types.Nat) + (b :: GHC.Types.Nat) + :: GHC.Types.Nat class GHC.TypeNats.KnownNat (n :: GHC.Types.Nat) where GHC.TypeNats.natSing :: GHC.TypeNats.SNat n {-# MINIMAL natSing #-} +type family GHC.TypeNats.Log2 (a :: GHC.Types.Nat) :: GHC.Types.Nat +type family GHC.TypeNats.Mod (a :: GHC.Types.Nat) + (b :: GHC.Types.Nat) + :: GHC.Types.Nat data GHC.Types.Nat -data GHC.TypeNats.SomeNat where - GHC.TypeNats.SomeNat :: GHC.TypeNats.KnownNat n => - (Data.Proxy.Proxy n) -> GHC.TypeNats.SomeNat +data GHC.TypeNats.SomeNat + = forall (n :: GHC.Types.Nat). + GHC.TypeNats.KnownNat n => + GHC.TypeNats.SomeNat (Data.Proxy.Proxy n) data GHC.Types.Symbol type family (GHC.TypeNats.^) (a :: GHC.Types.Nat) (b :: GHC.Types.Nat) diff --git a/testsuite/tests/ghci/scripts/T9293.stderr b/testsuite/tests/ghci/scripts/T9293.stderr index 77cf2da0ec..4a72589688 100644 --- a/testsuite/tests/ghci/scripts/T9293.stderr +++ b/testsuite/tests/ghci/scripts/T9293.stderr @@ -1,19 +1,19 @@ <interactive>:4:1: error: • Illegal generalised algebraic data declaration for ‘T’ - (Use GADTs to allow GADTs) + (Enable the GADTs extension to allow this) • In the data declaration for ‘T’ ghci057.hs:3:3: error: • Data constructor ‘C’ has existential type variables, a context, or a specialised result type C :: T Int - (Use ExistentialQuantification or GADTs to allow this) + (Enable ExistentialQuantification or GADTs to allow this) • In the definition of data constructor ‘C’ In the data type declaration for ‘T’ ghci057.hs:3:3: error: • Data constructor ‘C’ has existential type variables, a context, or a specialised result type C :: T Int - (Use ExistentialQuantification or GADTs to allow this) + (Enable ExistentialQuantification or GADTs to allow this) • In the definition of data constructor ‘C’ In the data type declaration for ‘T’ diff --git a/testsuite/tests/ghci/scripts/T9293.stdout b/testsuite/tests/ghci/scripts/T9293.stdout index b2de5417a2..2e5adc404c 100644 --- a/testsuite/tests/ghci/scripts/T9293.stdout +++ b/testsuite/tests/ghci/scripts/T9293.stdout @@ -6,6 +6,9 @@ with the following modifiers: GHCi-specific dynamic flag settings: other dynamic, non-language, flag settings: -fno-diagnostics-show-caret + -fexternal-dynamic-refs + -fignore-optim-changes + -fignore-hpc-changes -fno-ghci-history -fimplicit-import-qualified -fshow-warning-groups @@ -22,6 +25,9 @@ with the following modifiers: GHCi-specific dynamic flag settings: other dynamic, non-language, flag settings: -fno-diagnostics-show-caret + -fexternal-dynamic-refs + -fignore-optim-changes + -fignore-hpc-changes -fno-ghci-history -fimplicit-import-qualified -fshow-warning-groups @@ -37,6 +43,9 @@ with the following modifiers: GHCi-specific dynamic flag settings: other dynamic, non-language, flag settings: -fno-diagnostics-show-caret + -fexternal-dynamic-refs + -fignore-optim-changes + -fignore-hpc-changes -fno-ghci-history -fimplicit-import-qualified -fshow-warning-groups @@ -54,6 +63,9 @@ with the following modifiers: GHCi-specific dynamic flag settings: other dynamic, non-language, flag settings: -fno-diagnostics-show-caret + -fexternal-dynamic-refs + -fignore-optim-changes + -fignore-hpc-changes -fno-ghci-history -fimplicit-import-qualified -fshow-warning-groups diff --git a/testsuite/tests/ghci/scripts/T9293.stdout-mingw32 b/testsuite/tests/ghci/scripts/T9293.stdout-mingw32 new file mode 100644 index 0000000000..c5be11aa58 --- /dev/null +++ b/testsuite/tests/ghci/scripts/T9293.stdout-mingw32 @@ -0,0 +1,70 @@ +options currently set: none. +base language is: Haskell2010 +with the following modifiers: + -XNoDatatypeContexts + -XNondecreasingIndentation +GHCi-specific dynamic flag settings: +other dynamic, non-language, flag settings: + -fno-diagnostics-show-caret + -fignore-optim-changes + -fignore-hpc-changes + -fno-ghci-history + -fimplicit-import-qualified + -fshow-warning-groups +warning settings: +Should fail, GADTs is not enabled +options currently set: none. +base language is: Haskell2010 +with the following modifiers: + -XNoDatatypeContexts + -XGADTSyntax + -XGADTs + -XMonoLocalBinds + -XNondecreasingIndentation +GHCi-specific dynamic flag settings: +other dynamic, non-language, flag settings: + -fno-diagnostics-show-caret + -fignore-optim-changes + -fignore-hpc-changes + -fno-ghci-history + -fimplicit-import-qualified + -fshow-warning-groups +warning settings: +Should work, GADTs is in force from :set +options currently set: none. +base language is: Haskell2010 +with the following modifiers: + -XNoDatatypeContexts + -XGADTSyntax + -XMonoLocalBinds + -XNondecreasingIndentation +GHCi-specific dynamic flag settings: +other dynamic, non-language, flag settings: + -fno-diagnostics-show-caret + -fignore-optim-changes + -fignore-hpc-changes + -fno-ghci-history + -fimplicit-import-qualified + -fshow-warning-groups +warning settings: +Should fail, GADTs is now disabled +base language is: Haskell2010 +with the following modifiers: + -XNoDatatypeContexts + -XExtendedDefaultRules + -XGADTSyntax + -XGADTs + -XMonoLocalBinds + -XNoMonomorphismRestriction + -XNondecreasingIndentation +GHCi-specific dynamic flag settings: +other dynamic, non-language, flag settings: + -fno-diagnostics-show-caret + -fignore-optim-changes + -fignore-hpc-changes + -fno-ghci-history + -fimplicit-import-qualified + -fshow-warning-groups +warning settings: +Should fail, GADTs is only enabled at the prompt +C :: T Int diff --git a/testsuite/tests/ghci/scripts/T9881.stdout b/testsuite/tests/ghci/scripts/T9881.stdout index 18fa4d521f..68acea7c61 100644 --- a/testsuite/tests/ghci/scripts/T9881.stdout +++ b/testsuite/tests/ghci/scripts/T9881.stdout @@ -9,6 +9,8 @@ instance Monoid Data.ByteString.Lazy.ByteString -- Defined in ‘Data.ByteString.Lazy.Internal’ instance Ord Data.ByteString.Lazy.ByteString -- Defined in ‘Data.ByteString.Lazy.Internal’ +instance Semigroup Data.ByteString.Lazy.ByteString + -- Defined in ‘Data.ByteString.Lazy.Internal’ instance Show Data.ByteString.Lazy.ByteString -- Defined in ‘Data.ByteString.Lazy.Internal’ instance Read Data.ByteString.Lazy.ByteString @@ -26,6 +28,8 @@ instance Monoid Data.ByteString.ByteString -- Defined in ‘Data.ByteString.Internal’ instance Ord Data.ByteString.ByteString -- Defined in ‘Data.ByteString.Internal’ +instance Semigroup Data.ByteString.ByteString + -- Defined in ‘Data.ByteString.Internal’ instance Show Data.ByteString.ByteString -- Defined in ‘Data.ByteString.Internal’ instance Read Data.ByteString.ByteString diff --git a/testsuite/tests/ghci/scripts/all.T b/testsuite/tests/ghci/scripts/all.T index 8c3a2f55ee..290c274a94 100755 --- a/testsuite/tests/ghci/scripts/all.T +++ b/testsuite/tests/ghci/scripts/all.T @@ -1,5 +1,12 @@ # coding=utf8 +# Note [Disabling ghci-leak-check] +# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +# The -fno-ghci-leak-check is because this test prints the current GHC settings +# and the ghci-leak-check is turned off in DEBUG mode. See #15372. So we need to +# turn it off in non-DEBUG mode, too, so that one stdout works for both modes. +# After #15372 is fully fixed, these "extra_hc_opts" should be removed. + test('ghci001', combined_output, ghci_script, ['ghci001.script']) test('ghci002', combined_output, ghci_script, ['ghci002.script']) test('ghci003', combined_output, ghci_script, ['ghci003.script']) @@ -91,7 +98,9 @@ test('ghci056', extra_run_opts('ghci056_c.o')], ghci_script, ['ghci056.script']) -test('ghci057', normal, ghci_script, ['ghci057.script']) +test('ghci057', extra_hc_opts("-fno-ghci-leak-check"), ghci_script, ['ghci057.script']) + # See Note [Disabling ghci-leak-check] + test('ghci060', normal, ghci_script, ['ghci060.script']) test('ghci061', normal, ghci_script, ['ghci061.script']) test('ghci062', [extra_files(['ghci062/', 'ghci062/Test.hs']), @@ -115,7 +124,7 @@ test('T4087', normal, ghci_script, ['T4087.script']) test('T4015', normal, ghci_script, ['T4015.script']) test('T4127', normal, ghci_script, ['T4127.script']) test('T4127a', normal, ghci_script, ['T4127a.script']) -test('T4316', reqlib('mtl'), ghci_script, ['T4316.script']) +test('T4316', normal, ghci_script, ['T4316.script']) test('T4832', normal, ghci_script, ['T4832.script']) test('T5045', normal, ghci_script, ['T5045.script']) test('T5130', normal, ghci_script, ['T5130.script']) @@ -190,7 +199,10 @@ test('T9181', normal, ghci_script, ['T9181.script']) test('T9086b', normal, ghci_script, ['T9086b.script']) test('T9140', combined_output, ghci_script, ['T9140.script']) test('T9658', normal, ghci_script, ['T9658.script']) -test('T9293', extra_files(['ghci057.hs']), ghci_script, ['T9293.script']) + +test('T9293', [extra_hc_opts('-fno-ghci-leak-check'), extra_files(['ghci057.hs'])], ghci_script, ['T9293.script']) + # See Note [Disabling ghci-leak-check] + test('T9762', [ unless(have_dynamic(),skip) , pre_cmd('$MAKE -s --no-print-directory T9762_prep') @@ -201,6 +213,7 @@ test('T9878', [], ghci_script, ['T9878.script']) test('T9878b', [extra_run_opts('-fobject-code')], ghci_script, ['T9878b.script']) test('T10018', normal, ghci_script, ['T10018.script']) +test('T10059', normal, ghci_script, ['T10059.script']) test('T10122', normal, ghci_script, ['T10122.script']) test('T10321', normal, ghci_script, ['T10321.script']) @@ -238,14 +251,16 @@ test('T11376', normal, ghci_script, ['T11376.script']) test('T12007', normal, ghci_script, ['T12007.script']) test('T11975', normal, ghci_script, ['T11975.script']) test('T10963', normal, ghci_script, ['T10963.script']) -test('T11547', normal, ghci_script, ['T11547.script']) +test('T11721', normal, ghci_script, ['T11721.script']) +test('T12023', normal, run_command, + ['$MAKE -s --no-print-directory T12023']) test('T12520', normal, ghci_script, ['T12520.script']) -test('T12091', - [expect_broken(12091), extra_run_opts('-fobject-code')], - ghci_script, ['T12091.script']) +test('T12091', [extra_run_opts('-fobject-code')], ghci_script, + ['T12091.script']) test('T12523', normal, ghci_script, ['T12523.script']) test('T12024', normal, ghci_script, ['T12024.script']) -test('T12447', expect_broken(12447), ghci_script, ['T12447.script']) +test('T12158', expect_broken(12158), ghci_script, ['T12158.script']) +test('T12447', normal, ghci_script, ['T12447.script']) test('T10249', normal, ghci_script, ['T10249.script']) test('T12550', normal, ghci_script, ['T12550.script']) test('StaticPtr', normal, ghci_script, ['StaticPtr.script']) @@ -257,3 +272,15 @@ test('T13466', normal, ghci_script, ['T13466.script']) test('GhciCurDir', normal, ghci_script, ['GhciCurDir.script']) test('T13591', expect_broken(13591), ghci_script, ['T13591.script']) test('T13699', normal, ghci_script, ['T13699.script']) +test('T13988', normal, ghci_script, ['T13988.script']) +test('T13407', normal, ghci_script, ['T13407.script']) +test('T13963', normal, ghci_script, ['T13963.script']) +test('T14342', [extra_hc_opts("-XOverloadedStrings -XRebindableSyntax")], + ghci_script, ['T14342.script']) +test('T14676', extra_files(['../prog002']), ghci_script, ['T14676.script']) +test('T14796', normal, ghci_script, ['T14796.script']) +test('T14969', normal, ghci_script, ['T14969.script']) +test('T15259', normal, ghci_script, ['T15259.script']) +test('T15341', normal, ghci_script, ['T15341.script']) +test('T15568', normal, ghci_script, ['T15568.script']) +test('T15325', normal, ghci_script, ['T15325.script']) diff --git a/testsuite/tests/ghci/scripts/ghci008.stdout b/testsuite/tests/ghci/scripts/ghci008.stdout index f27edfbf25..6c105eb731 100644 --- a/testsuite/tests/ghci/scripts/ghci008.stdout +++ b/testsuite/tests/ghci/scripts/ghci008.stdout @@ -35,5 +35,5 @@ class (RealFrac a, Floating a) => RealFloat a where -- Defined in ‘GHC.Float’ instance RealFloat Float -- Defined in ‘GHC.Float’ instance RealFloat Double -- Defined in ‘GHC.Float’ -base-4.10.0.0:Data.OldList.isPrefixOf :: Eq a => [a] -> [a] -> Bool - -- Defined in ‘base-4.10.0.0:Data.OldList’ +base-4.12.0.0:Data.OldList.isPrefixOf :: Eq a => [a] -> [a] -> Bool + -- Defined in ‘base-4.12.0.0:Data.OldList’ diff --git a/testsuite/tests/ghci/scripts/ghci011.stdout b/testsuite/tests/ghci/scripts/ghci011.stdout index 372930d66d..7bd58dcc24 100644 --- a/testsuite/tests/ghci/scripts/ghci011.stdout +++ b/testsuite/tests/ghci/scripts/ghci011.stdout @@ -5,6 +5,7 @@ instance Functor [] -- Defined in ‘GHC.Base’ instance Monad [] -- Defined in ‘GHC.Base’ instance Monoid [a] -- Defined in ‘GHC.Base’ instance Ord a => Ord [a] -- Defined in ‘GHC.Classes’ +instance Semigroup [a] -- Defined in ‘GHC.Base’ instance Show a => Show [a] -- Defined in ‘GHC.Show’ instance Read a => Read [a] -- Defined in ‘GHC.Read’ instance Foldable [] -- Defined in ‘Data.Foldable’ @@ -13,6 +14,7 @@ data () = () -- Defined in ‘GHC.Tuple’ instance Eq () -- Defined in ‘GHC.Classes’ instance Monoid () -- Defined in ‘GHC.Base’ instance Ord () -- Defined in ‘GHC.Classes’ +instance Semigroup () -- Defined in ‘GHC.Base’ instance Show () -- Defined in ‘GHC.Show’ instance Read () -- Defined in ‘GHC.Read’ instance Enum () -- Defined in ‘GHC.Enum’ @@ -25,6 +27,8 @@ instance Monoid a => Monad ((,) a) -- Defined in ‘GHC.Base’ instance (Monoid a, Monoid b) => Monoid (a, b) -- Defined in ‘GHC.Base’ instance (Ord a, Ord b) => Ord (a, b) -- Defined in ‘GHC.Classes’ +instance (Semigroup a, Semigroup b) => Semigroup (a, b) + -- Defined in ‘GHC.Base’ instance (Show a, Show b) => Show (a, b) -- Defined in ‘GHC.Show’ instance (Read a, Read b) => Read (a, b) -- Defined in ‘GHC.Read’ instance Foldable ((,) a) -- Defined in ‘Data.Foldable’ diff --git a/testsuite/tests/ghci/scripts/ghci020.stdout b/testsuite/tests/ghci/scripts/ghci020.stdout index 3995bc0b20..6ae0c4ccfe 100644 --- a/testsuite/tests/ghci/scripts/ghci020.stdout +++ b/testsuite/tests/ghci/scripts/ghci020.stdout @@ -1,6 +1,7 @@ data (->) (a :: TYPE q) (b :: TYPE r) -- Defined in ‘GHC.Prim’ -infixr 0 `(->)` +infixr 0 -> instance Applicative ((->) a) -- Defined in ‘GHC.Base’ instance Functor ((->) r) -- Defined in ‘GHC.Base’ instance Monad ((->) r) -- Defined in ‘GHC.Base’ instance Monoid b => Monoid (a -> b) -- Defined in ‘GHC.Base’ +instance Semigroup b => Semigroup (a -> b) -- Defined in ‘GHC.Base’ diff --git a/testsuite/tests/ghci/scripts/ghci024.stdout b/testsuite/tests/ghci/scripts/ghci024.stdout index 978b6f9205..f38393bad4 100644 --- a/testsuite/tests/ghci/scripts/ghci024.stdout +++ b/testsuite/tests/ghci/scripts/ghci024.stdout @@ -7,6 +7,9 @@ with the following modifiers: GHCi-specific dynamic flag settings: other dynamic, non-language, flag settings: -fno-diagnostics-show-caret + -fexternal-dynamic-refs + -fignore-optim-changes + -fignore-hpc-changes -fno-ghci-history -fimplicit-import-qualified -fshow-warning-groups diff --git a/testsuite/tests/ghci/scripts/ghci024.stdout-mingw32 b/testsuite/tests/ghci/scripts/ghci024.stdout-mingw32 new file mode 100644 index 0000000000..1247616719 --- /dev/null +++ b/testsuite/tests/ghci/scripts/ghci024.stdout-mingw32 @@ -0,0 +1,40 @@ +~~~~~~~~~~ Testing :set +options currently set: none. +base language is: Haskell2010 +with the following modifiers: + -XNoDatatypeContexts + -XNondecreasingIndentation +GHCi-specific dynamic flag settings: +other dynamic, non-language, flag settings: + -fno-diagnostics-show-caret + -fignore-optim-changes + -fignore-hpc-changes + -fno-ghci-history + -fimplicit-import-qualified + -fshow-warning-groups +warning settings: +~~~~~~~~~~ Testing :set -a +options currently set: none. +base language is: Haskell2010 +all active language options: +GHCi-specific dynamic flag settings: + -fno-print-explicit-foralls +other dynamic, non-language, flag settings: +warning settings: + -Wno-implicit-prelude +~~~~~~~~~~ Testing :show languages +base language is: Haskell2010 +with the following modifiers: + -XNoDatatypeContexts + -XNondecreasingIndentation +~~~~~~~~~~ Testing :show languages, with -XMagicHash +base language is: Haskell2010 +with the following modifiers: + -XNoDatatypeContexts + -XMagicHash + -XNondecreasingIndentation +~~~~~~~~~~ Testing :show packages +active package flags: none +~~~~~~~~~~ Testing :show packages, including the ghc package +active package flags: + -package ghc diff --git a/testsuite/tests/ghci/scripts/ghci025.stdout b/testsuite/tests/ghci/scripts/ghci025.stdout index d660d233cd..e5638b07e9 100644 --- a/testsuite/tests/ghci/scripts/ghci025.stdout +++ b/testsuite/tests/ghci/scripts/ghci025.stdout @@ -8,18 +8,18 @@ class C a b ... c1 :: (C a b, N b) => a -> b c2 :: (C a b, N b, S b) => a -> b -c3 :: C a b => forall a. a -> b -c4 :: C a b => forall a1. a1 -> b +c3 :: C a b => a -> b +c4 :: C a b => a1 -> b -- imported via Control.Monad class (GHC.Base.Alternative m, Monad m) => MonadPlus (m :: * -> *) ... -mplus :: MonadPlus m => forall a. m a -> m a -> m a -mzero :: MonadPlus m => forall a. m a +mplus :: MonadPlus m => m a -> m a -> m a +mzero :: MonadPlus m => m a -- imported via Control.Monad, Prelude -(>>) :: Monad m => forall a b. m a -> m b -> m b -(>>=) :: Monad m => forall a b. m a -> (a -> m b) -> m b -fail :: Monad m => forall a. GHC.Base.String -> m a -return :: Monad m => forall a. a -> m a +(>>) :: Monad m => m a -> m b -> m b +(>>=) :: Monad m => m a -> (a -> m b) -> m b +fail :: Monad m => GHC.Base.String -> m a +return :: Monad m => a -> m a -- imported via Control.Monad, Prelude, T class GHC.Base.Applicative m => Monad (m :: * -> *) ... @@ -43,8 +43,7 @@ Nothing :: Maybe a class Eq a ... -- imported via Prelude, T -Prelude.length :: - Data.Foldable.Foldable t => forall a. t a -> GHC.Types.Int +Prelude.length :: Data.Foldable.Foldable t => t a -> GHC.Types.Int -- imported via T data T.Integer = ... T.length :: Data.ByteString.Internal.ByteString -> GHC.Types.Int @@ -57,8 +56,8 @@ class C a b ... c1 :: (C a b, N b) => a -> b c2 :: (C a b, N b, S b) => a -> b -c3 :: C a b => forall a. a -> b -c4 :: C a b => forall a1. a1 -> b +c3 :: C a b => a -> b +c4 :: C a b => a1 -> b :browse! T -- with -fprint-explicit-foralls -- defined locally T.length :: T.Integer @@ -68,8 +67,8 @@ class C a b ... c1 :: forall a b. (C a b, N b) => a -> b c2 :: forall a b. (C a b, N b, S b) => a -> b -c3 :: forall a b. C a b => forall a. a -> b -c4 :: forall a b. C a b => forall a1. a1 -> b +c3 :: forall a b a. C a b => a -> b +c4 :: forall a b a1. C a b => a1 -> b -- test :browse! <target> relative to different contexts :browse! Ghci025C -- from *Ghci025C> -- defined locally @@ -94,4 +93,3 @@ Ghci025C.g :: forall {a}. Num a => a -> a Ghci025C.h :: forall {a}. Integral a => a -> a -- defined locally f :: forall {a}. Num a => a -> a - diff --git a/testsuite/tests/ghci/scripts/ghci030.stdout b/testsuite/tests/ghci/scripts/ghci030.stdout index 9344bc39bd..49ce606456 100644 --- a/testsuite/tests/ghci/scripts/ghci030.stdout +++ b/testsuite/tests/ghci/scripts/ghci030.stdout @@ -1,6 +1,2 @@ -data D where - C :: (Int -> a) -> Char -> D - -- Defined at ghci030.hs:8:1 -data D where - C :: (Int -> a) -> Char -> D - -- Defined at ghci030.hs:8:10 +data D = forall a. C (Int -> a) Char -- Defined at ghci030.hs:8:1 +data D = forall a. C (Int -> a) Char -- Defined at ghci030.hs:8:10 diff --git a/testsuite/tests/ghci/scripts/ghci057.stderr b/testsuite/tests/ghci/scripts/ghci057.stderr index 77cf2da0ec..4a72589688 100644 --- a/testsuite/tests/ghci/scripts/ghci057.stderr +++ b/testsuite/tests/ghci/scripts/ghci057.stderr @@ -1,19 +1,19 @@ <interactive>:4:1: error: • Illegal generalised algebraic data declaration for ‘T’ - (Use GADTs to allow GADTs) + (Enable the GADTs extension to allow this) • In the data declaration for ‘T’ ghci057.hs:3:3: error: • Data constructor ‘C’ has existential type variables, a context, or a specialised result type C :: T Int - (Use ExistentialQuantification or GADTs to allow this) + (Enable ExistentialQuantification or GADTs to allow this) • In the definition of data constructor ‘C’ In the data type declaration for ‘T’ ghci057.hs:3:3: error: • Data constructor ‘C’ has existential type variables, a context, or a specialised result type C :: T Int - (Use ExistentialQuantification or GADTs to allow this) + (Enable ExistentialQuantification or GADTs to allow this) • In the definition of data constructor ‘C’ In the data type declaration for ‘T’ diff --git a/testsuite/tests/ghci/scripts/ghci057.stdout b/testsuite/tests/ghci/scripts/ghci057.stdout index b2de5417a2..2e5adc404c 100644 --- a/testsuite/tests/ghci/scripts/ghci057.stdout +++ b/testsuite/tests/ghci/scripts/ghci057.stdout @@ -6,6 +6,9 @@ with the following modifiers: GHCi-specific dynamic flag settings: other dynamic, non-language, flag settings: -fno-diagnostics-show-caret + -fexternal-dynamic-refs + -fignore-optim-changes + -fignore-hpc-changes -fno-ghci-history -fimplicit-import-qualified -fshow-warning-groups @@ -22,6 +25,9 @@ with the following modifiers: GHCi-specific dynamic flag settings: other dynamic, non-language, flag settings: -fno-diagnostics-show-caret + -fexternal-dynamic-refs + -fignore-optim-changes + -fignore-hpc-changes -fno-ghci-history -fimplicit-import-qualified -fshow-warning-groups @@ -37,6 +43,9 @@ with the following modifiers: GHCi-specific dynamic flag settings: other dynamic, non-language, flag settings: -fno-diagnostics-show-caret + -fexternal-dynamic-refs + -fignore-optim-changes + -fignore-hpc-changes -fno-ghci-history -fimplicit-import-qualified -fshow-warning-groups @@ -54,6 +63,9 @@ with the following modifiers: GHCi-specific dynamic flag settings: other dynamic, non-language, flag settings: -fno-diagnostics-show-caret + -fexternal-dynamic-refs + -fignore-optim-changes + -fignore-hpc-changes -fno-ghci-history -fimplicit-import-qualified -fshow-warning-groups diff --git a/testsuite/tests/ghci/scripts/ghci057.stdout-mingw32 b/testsuite/tests/ghci/scripts/ghci057.stdout-mingw32 new file mode 100644 index 0000000000..c5be11aa58 --- /dev/null +++ b/testsuite/tests/ghci/scripts/ghci057.stdout-mingw32 @@ -0,0 +1,70 @@ +options currently set: none. +base language is: Haskell2010 +with the following modifiers: + -XNoDatatypeContexts + -XNondecreasingIndentation +GHCi-specific dynamic flag settings: +other dynamic, non-language, flag settings: + -fno-diagnostics-show-caret + -fignore-optim-changes + -fignore-hpc-changes + -fno-ghci-history + -fimplicit-import-qualified + -fshow-warning-groups +warning settings: +Should fail, GADTs is not enabled +options currently set: none. +base language is: Haskell2010 +with the following modifiers: + -XNoDatatypeContexts + -XGADTSyntax + -XGADTs + -XMonoLocalBinds + -XNondecreasingIndentation +GHCi-specific dynamic flag settings: +other dynamic, non-language, flag settings: + -fno-diagnostics-show-caret + -fignore-optim-changes + -fignore-hpc-changes + -fno-ghci-history + -fimplicit-import-qualified + -fshow-warning-groups +warning settings: +Should work, GADTs is in force from :set +options currently set: none. +base language is: Haskell2010 +with the following modifiers: + -XNoDatatypeContexts + -XGADTSyntax + -XMonoLocalBinds + -XNondecreasingIndentation +GHCi-specific dynamic flag settings: +other dynamic, non-language, flag settings: + -fno-diagnostics-show-caret + -fignore-optim-changes + -fignore-hpc-changes + -fno-ghci-history + -fimplicit-import-qualified + -fshow-warning-groups +warning settings: +Should fail, GADTs is now disabled +base language is: Haskell2010 +with the following modifiers: + -XNoDatatypeContexts + -XExtendedDefaultRules + -XGADTSyntax + -XGADTs + -XMonoLocalBinds + -XNoMonomorphismRestriction + -XNondecreasingIndentation +GHCi-specific dynamic flag settings: +other dynamic, non-language, flag settings: + -fno-diagnostics-show-caret + -fignore-optim-changes + -fignore-hpc-changes + -fno-ghci-history + -fimplicit-import-qualified + -fshow-warning-groups +warning settings: +Should fail, GADTs is only enabled at the prompt +C :: T Int diff --git a/testsuite/tests/ghci/scripts/ghci058.stdout b/testsuite/tests/ghci/scripts/ghci058.stdout index 2028aee7fa..83c8bbd8cc 100644 --- a/testsuite/tests/ghci/scripts/ghci058.stdout +++ b/testsuite/tests/ghci/scripts/ghci058.stdout @@ -1,4 +1,4 @@ -Ok, 1 module loaded. +Ok, one module loaded. 'a' -Ok, 1 module loaded. +Ok, one module loaded. 'b' diff --git a/testsuite/tests/ghci/should_fail/T14608.hs b/testsuite/tests/ghci/should_fail/T14608.hs new file mode 100644 index 0000000000..87d5617e5c --- /dev/null +++ b/testsuite/tests/ghci/should_fail/T14608.hs @@ -0,0 +1,7 @@ +{-# LANGUAGE UnboxedTuples #-} +module T14608 where + +data UnboxedTupleData = MkUTD (# (),() #) + +doThings :: UnboxedTupleData -> () +doThings (MkUTD t) = () diff --git a/testsuite/tests/ghci/should_fail/T14608.script b/testsuite/tests/ghci/should_fail/T14608.script new file mode 100644 index 0000000000..c37a742461 --- /dev/null +++ b/testsuite/tests/ghci/should_fail/T14608.script @@ -0,0 +1 @@ +:load T14608.hs diff --git a/testsuite/tests/ghci/should_fail/T14608.stderr b/testsuite/tests/ghci/should_fail/T14608.stderr new file mode 100644 index 0000000000..fe84063af2 --- /dev/null +++ b/testsuite/tests/ghci/should_fail/T14608.stderr @@ -0,0 +1,3 @@ +Error: bytecode compiler can't handle unboxed tuples and sums. + Possibly due to foreign import/export decls in source. + Workaround: use -fobject-code, or compile this module to .o separately. diff --git a/testsuite/tests/ghci/should_fail/T15055.script b/testsuite/tests/ghci/should_fail/T15055.script new file mode 100644 index 0000000000..800944a5c0 --- /dev/null +++ b/testsuite/tests/ghci/should_fail/T15055.script @@ -0,0 +1 @@ +import GHC diff --git a/testsuite/tests/ghci/should_fail/T15055.stderr b/testsuite/tests/ghci/should_fail/T15055.stderr new file mode 100644 index 0000000000..fbf540edfd --- /dev/null +++ b/testsuite/tests/ghci/should_fail/T15055.stderr @@ -0,0 +1,6 @@ + +<no location info>: error: + Could not load module ‘GHC’ + It is a member of the hidden package ‘ghc-8.5’. + You can run ‘:set -package ghc’ to expose it. + (Note: this unloads all the modules in the current scope.) diff --git a/testsuite/tests/ghci/should_fail/all.T b/testsuite/tests/ghci/should_fail/all.T index 58a396ed86..01e5c36579 100644 --- a/testsuite/tests/ghci/should_fail/all.T +++ b/testsuite/tests/ghci/should_fail/all.T @@ -1,2 +1,4 @@ test('T10549', [], ghci_script, ['T10549.script']) test('T10549a', [], ghci_script, ['T10549a.script']) +test('T14608', [], ghci_script, ['T14608.script']) +test('T15055', normalise_version('ghc'), ghci_script, ['T15055.script']) diff --git a/testsuite/tests/ghci/should_run/T10145.stdout b/testsuite/tests/ghci/should_run/T10145.stdout index 3995bc0b20..6ae0c4ccfe 100644 --- a/testsuite/tests/ghci/should_run/T10145.stdout +++ b/testsuite/tests/ghci/should_run/T10145.stdout @@ -1,6 +1,7 @@ data (->) (a :: TYPE q) (b :: TYPE r) -- Defined in ‘GHC.Prim’ -infixr 0 `(->)` +infixr 0 -> instance Applicative ((->) a) -- Defined in ‘GHC.Base’ instance Functor ((->) r) -- Defined in ‘GHC.Base’ instance Monad ((->) r) -- Defined in ‘GHC.Base’ instance Monoid b => Monoid (a -> b) -- Defined in ‘GHC.Base’ +instance Semigroup b => Semigroup (a -> b) -- Defined in ‘GHC.Base’ diff --git a/testsuite/tests/ghci/should_run/T13825-ghci.hs b/testsuite/tests/ghci/should_run/T13825-ghci.hs new file mode 100644 index 0000000000..959cc7dc5b --- /dev/null +++ b/testsuite/tests/ghci/should_run/T13825-ghci.hs @@ -0,0 +1,38 @@ +module T13825 where + +import Data.Int +import Data.Word + +data Packed = + Packed + {-# UNPACK #-} !Float + {-# UNPACK #-} !Float + {-# UNPACK #-} !Int8 + {-# UNPACK #-} !Word16 + {-# UNPACK #-} !Float + {-# UNPACK #-} !Int + deriving (Show) + +-- Test a top-level constant +packed :: Packed +packed = Packed 1.0 2.0 3 4 5 6 + +packedAll :: [Packed] +packedAll = + packed : + [ Packed + (fromIntegral i) + (fromIntegral (i + 1)) + (fromIntegral (i + 2)) + (fromIntegral (i + 3)) + (fromIntegral (i + 3)) + (fromIntegral (i + 4)) + | i <- [1.. 4] + ] + +addOne :: Packed -> Packed +addOne (Packed a b c d e f) = + Packed (a + 1.0) (b + 1.0) (c + 1) (d + 1) (e + 1.0) (f + 1) + +mapAddOne :: [Packed] -> [Packed] +mapAddOne = map addOne diff --git a/testsuite/tests/ghci/should_run/T13825-ghci.script b/testsuite/tests/ghci/should_run/T13825-ghci.script new file mode 100644 index 0000000000..6cd22d9a1c --- /dev/null +++ b/testsuite/tests/ghci/should_run/T13825-ghci.script @@ -0,0 +1,13 @@ +:l T13825-ghci +let ghciPacked = Packed 1.0 2.0 3 4 5 6 +map addOne (ghciPacked : packedAll) +let ghciAddOne (Packed a b c d e f) = Packed (a + 1.0) (b + 1.0) (c + 1) (d + 1) (e + 1.0) (f + 1) +map ghciAddOne (ghciPacked : packedAll) + +:set -fobject-code +:l T13825-ghci +:set -fbyte-code +let ghciPacked = Packed 1.0 2.0 3 4 5 6 +map addOne (ghciPacked : packedAll) +let ghciAddOne (Packed a b c d e f) = Packed (a + 1.0) (b + 1.0) (c + 1) (d + 1) (e + 1.0) (f + 1) +map ghciAddOne (ghciPacked : packedAll) diff --git a/testsuite/tests/ghci/should_run/T13825-ghci.stdout b/testsuite/tests/ghci/should_run/T13825-ghci.stdout new file mode 100644 index 0000000000..4edee56c11 --- /dev/null +++ b/testsuite/tests/ghci/should_run/T13825-ghci.stdout @@ -0,0 +1,4 @@ +[Packed 2.0 3.0 4 5 6.0 7,Packed 2.0 3.0 4 5 6.0 7,Packed 2.0 3.0 4 5 5.0 6,Packed 3.0 4.0 5 6 6.0 7,Packed 4.0 5.0 6 7 7.0 8,Packed 5.0 6.0 7 8 8.0 9] +[Packed 2.0 3.0 4 5 6.0 7,Packed 2.0 3.0 4 5 6.0 7,Packed 2.0 3.0 4 5 5.0 6,Packed 3.0 4.0 5 6 6.0 7,Packed 4.0 5.0 6 7 7.0 8,Packed 5.0 6.0 7 8 8.0 9] +[Packed 2.0 3.0 4 5 6.0 7,Packed 2.0 3.0 4 5 6.0 7,Packed 2.0 3.0 4 5 5.0 6,Packed 3.0 4.0 5 6 6.0 7,Packed 4.0 5.0 6 7 7.0 8,Packed 5.0 6.0 7 8 8.0 9] +[Packed 2.0 3.0 4 5 6.0 7,Packed 2.0 3.0 4 5 6.0 7,Packed 2.0 3.0 4 5 5.0 6,Packed 3.0 4.0 5 6 6.0 7,Packed 4.0 5.0 6 7 7.0 8,Packed 5.0 6.0 7 8 8.0 9] diff --git a/testsuite/tests/ghci/should_run/T14125a.script b/testsuite/tests/ghci/should_run/T14125a.script new file mode 100644 index 0000000000..1667349160 --- /dev/null +++ b/testsuite/tests/ghci/should_run/T14125a.script @@ -0,0 +1,8 @@ +:set -XTypeFamilies +data family Foo a +data instance Foo Int = FooInt Int +:kind! Foo Int +let f (FooInt i) = i +:info f +:type +v f +:type f diff --git a/testsuite/tests/ghci/should_run/T14125a.stdout b/testsuite/tests/ghci/should_run/T14125a.stdout new file mode 100644 index 0000000000..7b4e85edd3 --- /dev/null +++ b/testsuite/tests/ghci/should_run/T14125a.stdout @@ -0,0 +1,5 @@ +Foo Int :: * += Foo Int +f :: Foo Int -> Int -- Defined at <interactive>:5:5 +f :: Foo Int -> Int +f :: Foo Int -> Int diff --git a/testsuite/tests/ghci/should_run/T14963a.hs b/testsuite/tests/ghci/should_run/T14963a.hs new file mode 100644 index 0000000000..b44e70394d --- /dev/null +++ b/testsuite/tests/ghci/should_run/T14963a.hs @@ -0,0 +1,2 @@ +test :: IO Bool +test = return True diff --git a/testsuite/tests/ghci/should_run/T14963a.script b/testsuite/tests/ghci/should_run/T14963a.script new file mode 100644 index 0000000000..add8e3619a --- /dev/null +++ b/testsuite/tests/ghci/should_run/T14963a.script @@ -0,0 +1,3 @@ +:l T14963a +:set -fdefer-type-errors +test diff --git a/testsuite/tests/ghci/should_run/T14963a.stdout b/testsuite/tests/ghci/should_run/T14963a.stdout new file mode 100644 index 0000000000..0ca95142bb --- /dev/null +++ b/testsuite/tests/ghci/should_run/T14963a.stdout @@ -0,0 +1 @@ +True diff --git a/testsuite/tests/ghci/should_run/T14963b.hs b/testsuite/tests/ghci/should_run/T14963b.hs new file mode 100644 index 0000000000..b44e70394d --- /dev/null +++ b/testsuite/tests/ghci/should_run/T14963b.hs @@ -0,0 +1,2 @@ +test :: IO Bool +test = return True diff --git a/testsuite/tests/ghci/should_run/T14963b.script b/testsuite/tests/ghci/should_run/T14963b.script new file mode 100644 index 0000000000..c2cb796d53 --- /dev/null +++ b/testsuite/tests/ghci/should_run/T14963b.script @@ -0,0 +1,3 @@ +:set -fdefer-type-errors +:l T14963b +test diff --git a/testsuite/tests/ghci/should_run/T14963b.stdout b/testsuite/tests/ghci/should_run/T14963b.stdout new file mode 100644 index 0000000000..0ca95142bb --- /dev/null +++ b/testsuite/tests/ghci/should_run/T14963b.stdout @@ -0,0 +1 @@ +True diff --git a/testsuite/tests/ghci/should_run/T14963c.hs b/testsuite/tests/ghci/should_run/T14963c.hs new file mode 100644 index 0000000000..cac012e79f --- /dev/null +++ b/testsuite/tests/ghci/should_run/T14963c.hs @@ -0,0 +1,4 @@ +{-# OPTIONS_GHC -fdefer-type-errors #-} + +test :: IO Bool +test = return True diff --git a/testsuite/tests/ghci/should_run/T14963c.script b/testsuite/tests/ghci/should_run/T14963c.script new file mode 100644 index 0000000000..37dda62530 --- /dev/null +++ b/testsuite/tests/ghci/should_run/T14963c.script @@ -0,0 +1,3 @@ +:set -fdefer-type-errors +:l T14963c +test diff --git a/testsuite/tests/ghci/should_run/T14963c.stdout b/testsuite/tests/ghci/should_run/T14963c.stdout new file mode 100644 index 0000000000..0ca95142bb --- /dev/null +++ b/testsuite/tests/ghci/should_run/T14963c.stdout @@ -0,0 +1 @@ +True diff --git a/testsuite/tests/ghci/should_run/T15007.script b/testsuite/tests/ghci/should_run/T15007.script new file mode 100644 index 0000000000..04f2649294 --- /dev/null +++ b/testsuite/tests/ghci/should_run/T15007.script @@ -0,0 +1,3 @@ +1 +1 +_ diff --git a/testsuite/tests/ghci/should_run/T15007.stderr b/testsuite/tests/ghci/should_run/T15007.stderr new file mode 100644 index 0000000000..da1dc5d1ed --- /dev/null +++ b/testsuite/tests/ghci/should_run/T15007.stderr @@ -0,0 +1,9 @@ + +<interactive>:3:1: error: + • Found hole: _ :: t + Where: ‘t’ is a rigid type variable bound by + the inferred type of it :: t + at <interactive>:3:1 + • In the expression: _ + In an equation for ‘it’: it = _ + • Relevant bindings include it :: t (bound at <interactive>:3:1) diff --git a/testsuite/tests/ghci/should_run/T15007.stdout b/testsuite/tests/ghci/should_run/T15007.stdout new file mode 100644 index 0000000000..6ed281c757 --- /dev/null +++ b/testsuite/tests/ghci/should_run/T15007.stdout @@ -0,0 +1,2 @@ +1 +1 diff --git a/testsuite/tests/ghci/should_run/T7253.script b/testsuite/tests/ghci/should_run/T7253.script index 0ab8337bae..cad4a19746 100644 --- a/testsuite/tests/ghci/should_run/T7253.script +++ b/testsuite/tests/ghci/should_run/T7253.script @@ -55,7 +55,6 @@ upcase foo {-# RULES "map/map" forall f g xs. map f (map g xs) = map (f.g) xs #-} {-# ANN foo (Just "Hello") #-} -{-# NOVECTORISE foo #-} :seti -XRoleAnnotations :{ diff --git a/testsuite/tests/ghci/should_run/T7253.stderr b/testsuite/tests/ghci/should_run/T7253.stderr index f7dedda51b..448f91865d 100644 --- a/testsuite/tests/ghci/should_run/T7253.stderr +++ b/testsuite/tests/ghci/should_run/T7253.stderr @@ -2,7 +2,7 @@ <interactive>:19:1: warning: [-Wunrecognised-pragmas (in -Wdefault)] Unrecognised pragma -<interactive>:62:1: error: +<interactive>:61:1: error: • Role mismatch on variable b: Annotation says phantom but role representational is required • while checking a role annotation for ‘T1’ diff --git a/testsuite/tests/ghci/should_run/all.T b/testsuite/tests/ghci/should_run/all.T index fe33685193..d92b0e70b4 100644 --- a/testsuite/tests/ghci/should_run/all.T +++ b/testsuite/tests/ghci/should_run/all.T @@ -27,4 +27,10 @@ test('T11825', just_ghci, ghci_script, ['T11825.script']) test('T12128', just_ghci, ghci_script, ['T12128.script']) test('T12456', just_ghci, ghci_script, ['T12456.script']) test('T12549', just_ghci, ghci_script, ['T12549.script']) -test('BinaryArray', normal, compile_and_run, [''])
\ No newline at end of file +test('BinaryArray', normal, compile_and_run, ['']) +test('T14125a', just_ghci, ghci_script, ['T14125a.script']) +test('T13825-ghci',just_ghci, ghci_script, ['T13825-ghci.script']) +test('T14963a', just_ghci, ghci_script, ['T14963a.script']) +test('T14963b', just_ghci, ghci_script, ['T14963b.script']) +test('T14963c', [extra_hc_opts("-fdefer-type-errors")], ghci_script, ['T14963c.script']) +test('T15007', just_ghci, ghci_script, ['T15007.script']) diff --git a/testsuite/tests/haddock/haddock_examples/haddock.Test.stderr b/testsuite/tests/haddock/haddock_examples/haddock.Test.stderr index 8f06390348..d230d58eaa 100644 --- a/testsuite/tests/haddock/haddock_examples/haddock.Test.stderr +++ b/testsuite/tests/haddock/haddock_examples/haddock.Test.stderr @@ -17,7 +17,7 @@ visible a = a [3 of 3] Compiling Test ( Test.hs, Test.o ) ==================== Parser ==================== - +" Module : Test Copyright : (c) Simon Marlow 2002 License : BSD-style @@ -28,63 +28,65 @@ visible a = a This module illustrates & tests most of the features of Haddock. Testing references from the description: 'T', 'f', 'g', 'Visible.visible'. - +" module Test ( <IEGroup: 1>, <IEGroup: 2>, T(..), T2, T3(..), T4(..), T5(..), T6(..), N1(..), N2(..), N3(..), N4, N5(..), N6(..), N7(..), <IEGroup: 2>, R(..), R1(..), - test that we can export record selectors on their own:, p, q, u, + " test that we can export record selectors on their own:", p, q, u, <IEGroup: 1>, C(a, b), D(..), E, F(..), - Test that we can export a class method on its own:, a, + " Test that we can export a class method on its own:", a, <IEGroup: 1>, f, g, <IEGroup: 1>, <IEDocNamed: aux1>, <IEDocNamed: aux2>, <IEDocNamed: aux3>, <IEDocNamed: aux4>, <IEDocNamed: aux5>, <IEDocNamed: aux6>, <IEDocNamed: aux7>, <IEDocNamed: aux8>, <IEDocNamed: aux9>, <IEDocNamed: aux10>, <IEDocNamed: aux11>, <IEDocNamed: aux12>, - This is some inline documentation in the export list + " This is some inline documentation in the export list > a code block using bird-tracks > each line must begin with > (which isn't significant unless it - > is at the beginning of the line)., + > is at the beginning of the line).", <IEGroup: 1>, module Hidden, <IEGroup: 1>, module Visible, - nested-style doc comments , <IEGroup: 1>, Ex(..), <IEGroup: 1>, k, - l, m, o, <IEGroup: 1>, <IEGroup: 2>, - + " nested-style doc comments ", <IEGroup: 1>, Ex(..), <IEGroup: 1>, + k, l, m, o, <IEGroup: 1>, <IEGroup: 2>, + " > a literal line $ a non /literal/ line $ -, f' +", f' ) where import Hidden import Visible <document comment> data T a b - = This comment describes the 'A' constructor A Int (Maybe Float) | - This comment describes the 'B' constructor B (T a b, T Int Float) + = " This comment describes the 'A' constructor" + A Int (Maybe Float) | + " This comment describes the 'B' constructor" + B (T a b, T Int Float) <document comment> data T2 a b = T2 a b <document comment> data T3 a b = A1 a | B1 b data T4 a b = A2 a | B2 b -data T5 a b = documents 'A3' A3 a | documents 'B3' B3 b +data T5 a b = " documents 'A3'" A3 a | " documents 'B3'" B3 b <document comment> data T6 - = This is the doc for 'A4' A4 | - This is the doc for 'B4' B4 | - This is the doc for 'C4' C4 + = " This is the doc for 'A4'" A4 | + " This is the doc for 'B4'" B4 | + " This is the doc for 'C4'" C4 <document comment> newtype N1 a = N1 a <document comment> newtype N2 a b = N2 {n :: a b} <document comment> -newtype N3 a b = N3 {n3 :: a b this is the 'n3' field} +newtype N3 a b = N3 {n3 :: a b " this is the 'n3' field"} <document comment> newtype N4 a b = N4 a newtype N5 a b - = N5 {n5 :: a b no docs on the datatype or the constructor} -newtype N6 a b = docs on the constructor only N6 {n6 :: a b} + = N5 {n5 :: a b " no docs on the datatype or the constructor"} +newtype N6 a b = " docs on the constructor only" N6 {n6 :: a b} <document comment> -newtype N7 a b = The 'N7' constructor N7 {n7 :: a b} +newtype N7 a b = " The 'N7' constructor" N7 {n7 :: a b} class (D a) => C a where a :: IO a b :: [a] @@ -107,20 +109,20 @@ class F a where ff :: a <document comment> data R - = This is the 'C1' record constructor, with the following fields: - C1 {p :: Int This comment applies to the 'p' field, - q :: forall a. a -> a This comment applies to the 'q' field, - r, s :: Int This comment applies to both 'r' and 's'} | - This is the 'C2' record constructor, also with some fields: + = " This is the 'C1' record constructor, with the following fields:" + C1 {p :: Int " This comment applies to the 'p' field", + q :: forall a. a -> a " This comment applies to the 'q' field", + r, s :: Int " This comment applies to both 'r' and 's'"} | + " This is the 'C2' record constructor, also with some fields:" C2 {t :: T1 -> (T2 Int Int) -> (T3 Bool Bool) -> (T4 Float Float) -> T5 () (), u, v :: Int} <document comment> data R1 - = This is the 'C3' record constructor - C3 {s1 :: Int The 's1' record selector, - s2 :: Int The 's2' record selector, - s3 :: Int The 's3' record selector} + = " This is the 'C3' record constructor" + C3 {s1 :: Int " The 's1' record selector", + s2 :: Int " The 's2' record selector", + s3 :: Int " The 's3' record selector"} <document comment> <document comment> <document comment> @@ -151,26 +153,27 @@ data Ex a Ex4 (forall a. a -> a) <document comment> k :: - T () () This argument has type 'T' - -> (T2 Int Int) This argument has type 'T2 Int Int' + T () () " This argument has type 'T'" + -> (T2 Int Int) " This argument has type 'T2 Int Int'" -> (T3 Bool Bool - -> T4 Float Float) This argument has type @T3 Bool Bool -> T4 Float Float@ - -> T5 () () This argument has a very long description that should + -> T4 Float Float) " This argument has type @T3 Bool Bool -> T4 Float Float@" + -> T5 () () " This argument has a very long description that should hopefully cause some wrapping to happen when it is finally - rendered by Haddock in the generated HTML page. - -> IO () This is the result type -l :: (Int, Int, Float) takes a triple -> Int returns an 'Int' + rendered by Haddock in the generated HTML page." + -> IO () " This is the result type" +l :: (Int, Int, Float) " takes a triple" -> Int " returns an 'Int'" <document comment> m :: - R -> N1 () one of the arguments -> IO Int and the return value + R + -> N1 () " one of the arguments" -> IO Int " and the return value" <document comment> newn :: - R one of the arguments, an 'R' - -> N1 () one of the arguments -> IO Int + R " one of the arguments, an 'R'" + -> N1 () " one of the arguments" -> IO Int newn = undefined <document comment> foreign import ccall unsafe "header.h" o - :: Float The input float -> IO Float The output float + :: Float " The input float" -> IO Float " The output float" <document comment> newp :: Int newp = undefined diff --git a/testsuite/tests/haddock/should_compile_flag_haddock/T11768.stderr b/testsuite/tests/haddock/should_compile_flag_haddock/T11768.stderr index 060dd06ad2..997c2ef24c 100644 --- a/testsuite/tests/haddock/should_compile_flag_haddock/T11768.stderr +++ b/testsuite/tests/haddock/should_compile_flag_haddock/T11768.stderr @@ -3,10 +3,10 @@ module T11768 where data Foo = Foo - deriving Eq Documenting a single type + deriving Eq " Documenting a single type" data Bar = Bar - deriving (Eq Documenting one of multiple types, Ord) + deriving (Eq " Documenting one of multiple types", Ord) <document comment> deriving instance Read Bar diff --git a/testsuite/tests/haddock/should_compile_flag_haddock/all.T b/testsuite/tests/haddock/should_compile_flag_haddock/all.T index 7db4379b16..5450fcbe7f 100644 --- a/testsuite/tests/haddock/should_compile_flag_haddock/all.T +++ b/testsuite/tests/haddock/should_compile_flag_haddock/all.T @@ -39,6 +39,10 @@ test('haddockA029', normal, compile, ['-haddock -ddump-parsed']) test('haddockA030', normal, compile, ['-haddock -ddump-parsed']) test('haddockA031', normal, compile, ['-haddock -ddump-parsed -XExistentialQuantification']) test('haddockA032', normal, compile, ['-haddock -ddump-parsed']) +test('haddockA035', normal, compile, ['-haddock -ddump-parsed']) +test('haddockA036', normal, compile, ['-haddock -ddump-parsed']) +test('haddockA037', normal, compile, ['-haddock -ddump-parsed']) +test('haddockA038', normal, compile, ['-haddock -ddump-parsed']) # The tests below this line are not duplicated in # should_compile_noflag_haddock. diff --git a/testsuite/tests/haddock/should_compile_flag_haddock/haddockA014.stderr b/testsuite/tests/haddock/should_compile_flag_haddock/haddockA014.stderr index a70f624278..f55f8afab1 100644 --- a/testsuite/tests/haddock/should_compile_flag_haddock/haddockA014.stderr +++ b/testsuite/tests/haddock/should_compile_flag_haddock/haddockA014.stderr @@ -1,6 +1,6 @@ ==================== Parser ==================== - a header +" a header" module HeaderTest where <document comment> x = 0 diff --git a/testsuite/tests/haddock/should_compile_flag_haddock/haddockA015.stderr b/testsuite/tests/haddock/should_compile_flag_haddock/haddockA015.stderr index 3bfc17d811..15adf3e54e 100644 --- a/testsuite/tests/haddock/should_compile_flag_haddock/haddockA015.stderr +++ b/testsuite/tests/haddock/should_compile_flag_haddock/haddockA015.stderr @@ -1,6 +1,6 @@ ==================== Parser ==================== - a header +" a header" module HeaderTest where <document comment> x = 0 diff --git a/testsuite/tests/haddock/should_compile_flag_haddock/haddockA016.stderr b/testsuite/tests/haddock/should_compile_flag_haddock/haddockA016.stderr index 48dd0870c9..e9ccec44a0 100644 --- a/testsuite/tests/haddock/should_compile_flag_haddock/haddockA016.stderr +++ b/testsuite/tests/haddock/should_compile_flag_haddock/haddockA016.stderr @@ -1,6 +1,6 @@ ==================== Parser ==================== -Module description +"Module description" module A where diff --git a/testsuite/tests/haddock/should_compile_flag_haddock/haddockA018.stderr b/testsuite/tests/haddock/should_compile_flag_haddock/haddockA018.stderr index 2aa5245f50..357f7540e2 100644 --- a/testsuite/tests/haddock/should_compile_flag_haddock/haddockA018.stderr +++ b/testsuite/tests/haddock/should_compile_flag_haddock/haddockA018.stderr @@ -1,6 +1,6 @@ ==================== Parser ==================== - module header bla bla +" module header bla bla " module A where diff --git a/testsuite/tests/haddock/should_compile_flag_haddock/haddockA019.stderr b/testsuite/tests/haddock/should_compile_flag_haddock/haddockA019.stderr index ca316bc8b8..c7a34730d9 100644 --- a/testsuite/tests/haddock/should_compile_flag_haddock/haddockA019.stderr +++ b/testsuite/tests/haddock/should_compile_flag_haddock/haddockA019.stderr @@ -1,7 +1,7 @@ ==================== Parser ==================== module A ( - bla bla, blabla + " bla bla", " blabla " ) where diff --git a/testsuite/tests/haddock/should_compile_flag_haddock/haddockA020.stderr b/testsuite/tests/haddock/should_compile_flag_haddock/haddockA020.stderr index 2aaa3eba98..660b28036e 100644 --- a/testsuite/tests/haddock/should_compile_flag_haddock/haddockA020.stderr +++ b/testsuite/tests/haddock/should_compile_flag_haddock/haddockA020.stderr @@ -1,7 +1,7 @@ ==================== Parser ==================== module A ( - bla bla, blabla , x, <IEGroup: 2>, qweljqwelkqjwelqjkq + " bla bla", " blabla ", x, <IEGroup: 2>, " qweljqwelkqjwelqjkq" ) where x = True diff --git a/testsuite/tests/haddock/should_compile_flag_haddock/haddockA021.stderr b/testsuite/tests/haddock/should_compile_flag_haddock/haddockA021.stderr index 162c403b84..befbee45f9 100644 --- a/testsuite/tests/haddock/should_compile_flag_haddock/haddockA021.stderr +++ b/testsuite/tests/haddock/should_compile_flag_haddock/haddockA021.stderr @@ -1,8 +1,8 @@ ==================== Parser ==================== module A ( - bla bla, blabla , x, <IEGroup: 2>, qweljqwelkqjwelqjkq, y, - dkashdakj, z, <IEGroup: 1> + " bla bla", " blabla ", x, <IEGroup: 2>, " qweljqwelkqjwelqjkq", y, + " dkashdakj", z, <IEGroup: 1> ) where x = True y = False diff --git a/testsuite/tests/haddock/should_compile_flag_haddock/haddockA023.stderr b/testsuite/tests/haddock/should_compile_flag_haddock/haddockA023.stderr index fcb953a495..d04558c301 100644 --- a/testsuite/tests/haddock/should_compile_flag_haddock/haddockA023.stderr +++ b/testsuite/tests/haddock/should_compile_flag_haddock/haddockA023.stderr @@ -1,7 +1,7 @@ ==================== Parser ==================== module ShouldCompile where -test :: (Eq a) => [a] doc1 -> [a] doc2 -> [a] doc3 +test :: (Eq a) => [a] " doc1" -> [a] " doc2 " -> [a] " doc3" test xs ys = xs diff --git a/testsuite/tests/haddock/should_compile_flag_haddock/haddockA024.stderr b/testsuite/tests/haddock/should_compile_flag_haddock/haddockA024.stderr index 9f57f5df07..c453e071a3 100644 --- a/testsuite/tests/haddock/should_compile_flag_haddock/haddockA024.stderr +++ b/testsuite/tests/haddock/should_compile_flag_haddock/haddockA024.stderr @@ -1,7 +1,7 @@ ==================== Parser ==================== module ShouldCompile where -test2 :: a doc1 -> b doc2 -> a doc 3 +test2 :: a " doc1 " -> b " doc2 " -> a " doc 3 " test2 x y = x diff --git a/testsuite/tests/haddock/should_compile_flag_haddock/haddockA025.stderr b/testsuite/tests/haddock/should_compile_flag_haddock/haddockA025.stderr index 472ec1a1eb..e0b8a4a7bf 100644 --- a/testsuite/tests/haddock/should_compile_flag_haddock/haddockA025.stderr +++ b/testsuite/tests/haddock/should_compile_flag_haddock/haddockA025.stderr @@ -1,7 +1,7 @@ ==================== Parser ==================== module ShouldCompile where -test2 :: a doc1 -> a +test2 :: a " doc1 " -> a test2 x = x diff --git a/testsuite/tests/haddock/should_compile_flag_haddock/haddockA026.stderr b/testsuite/tests/haddock/should_compile_flag_haddock/haddockA026.stderr index 5f7335b6b9..37135099a0 100644 --- a/testsuite/tests/haddock/should_compile_flag_haddock/haddockA026.stderr +++ b/testsuite/tests/haddock/should_compile_flag_haddock/haddockA026.stderr @@ -2,7 +2,7 @@ ==================== Parser ==================== module ShouldCompile where test :: - (Eq a) => [a] doc1 -> forall b. [b] doc2 -> [a] doc3 + (Eq a) => [a] " doc1" -> forall b. [b] " doc2 " -> [a] " doc3" test xs ys = xs diff --git a/testsuite/tests/haddock/should_compile_flag_haddock/haddockA027.stderr b/testsuite/tests/haddock/should_compile_flag_haddock/haddockA027.stderr index e7707c5ec0..0bbb612119 100644 --- a/testsuite/tests/haddock/should_compile_flag_haddock/haddockA027.stderr +++ b/testsuite/tests/haddock/should_compile_flag_haddock/haddockA027.stderr @@ -2,9 +2,9 @@ ==================== Parser ==================== module ShouldCompile where test :: - [a] doc1 + [a] " doc1" -> forall b. - (Ord b) => [b] doc2 -> forall c. (Num c) => [c] doc3 -> [a] + (Ord b) => [b] " doc2 " -> forall c. (Num c) => [c] " doc3" -> [a] test xs ys zs = xs diff --git a/testsuite/tests/haddock/should_compile_flag_haddock/haddockA028.stderr b/testsuite/tests/haddock/should_compile_flag_haddock/haddockA028.stderr index 47d2468ea5..3c1bbc9565 100644 --- a/testsuite/tests/haddock/should_compile_flag_haddock/haddockA028.stderr +++ b/testsuite/tests/haddock/should_compile_flag_haddock/haddockA028.stderr @@ -2,7 +2,7 @@ ==================== Parser ==================== module ShouldCompile where data a <--> b = Mk a b -test :: [a] doc1 -> a <--> b -> [a] blabla +test :: [a] " doc1 " -> a <--> b -> [a] " blabla" test xs ys = xs diff --git a/testsuite/tests/haddock/should_compile_flag_haddock/haddockA029.stderr b/testsuite/tests/haddock/should_compile_flag_haddock/haddockA029.stderr index 820ffa6708..7271238e3e 100644 --- a/testsuite/tests/haddock/should_compile_flag_haddock/haddockA029.stderr +++ b/testsuite/tests/haddock/should_compile_flag_haddock/haddockA029.stderr @@ -2,6 +2,6 @@ ==================== Parser ==================== module ShouldCompile where data A - = A comment that documents the first constructor A | B | C | D + = " A comment that documents the first constructor" A | B | C | D diff --git a/testsuite/tests/haddock/should_compile_flag_haddock/haddockA030.stderr b/testsuite/tests/haddock/should_compile_flag_haddock/haddockA030.stderr index b0ef139199..e09cfa2187 100644 --- a/testsuite/tests/haddock/should_compile_flag_haddock/haddockA030.stderr +++ b/testsuite/tests/haddock/should_compile_flag_haddock/haddockA030.stderr @@ -2,6 +2,9 @@ ==================== Parser ==================== module ShouldCompile where data A - = comment for A A | comment for B B | comment for C C | D + = " comment for A " A | + " comment for B " B | + " comment for C " C | + D diff --git a/testsuite/tests/haddock/should_compile_flag_haddock/haddockA031.stderr b/testsuite/tests/haddock/should_compile_flag_haddock/haddockA031.stderr index 1d033cd6d7..eb6fcaef1e 100644 --- a/testsuite/tests/haddock/should_compile_flag_haddock/haddockA031.stderr +++ b/testsuite/tests/haddock/should_compile_flag_haddock/haddockA031.stderr @@ -3,7 +3,7 @@ module ShouldCompile where data A = A | - comment for B forall a. B a a | - comment for C forall a. Num a => C a + " comment for B " forall a. B a a | + " comment for C " forall a. Num a => C a diff --git a/testsuite/tests/haddock/should_compile_flag_haddock/haddockA032.stderr b/testsuite/tests/haddock/should_compile_flag_haddock/haddockA032.stderr index 5cf2d9b034..eec30285f5 100644 --- a/testsuite/tests/haddock/should_compile_flag_haddock/haddockA032.stderr +++ b/testsuite/tests/haddock/should_compile_flag_haddock/haddockA032.stderr @@ -3,8 +3,8 @@ module ShouldCompile where data R a = R {field1 :: a, - field2 :: a comment for field2, - field3 :: a comment for field3, - field4 :: a comment for field4 } + field2 :: a " comment for field2", + field3 :: a " comment for field3", + field4 :: a " comment for field4 "} diff --git a/testsuite/tests/haddock/should_compile_flag_haddock/haddockA034.stderr b/testsuite/tests/haddock/should_compile_flag_haddock/haddockA034.stderr index f743393349..64478fed12 100644 --- a/testsuite/tests/haddock/should_compile_flag_haddock/haddockA034.stderr +++ b/testsuite/tests/haddock/should_compile_flag_haddock/haddockA034.stderr @@ -2,4 +2,6 @@ ==================== Parser ==================== module Hi where <document comment> -data Hi where This is a GADT constructor. Hi :: () -> Hi +data Hi where " This is a GADT constructor." Hi :: () -> Hi + + diff --git a/testsuite/tests/haddock/should_compile_flag_haddock/haddockA035.hs b/testsuite/tests/haddock/should_compile_flag_haddock/haddockA035.hs new file mode 100644 index 0000000000..25ed2acb83 --- /dev/null +++ b/testsuite/tests/haddock/should_compile_flag_haddock/haddockA035.hs @@ -0,0 +1,9 @@ +{-# LANGUAGE GADTs #-} + +module Hi where + +data Hi where + Hi :: () -- ^ This is a comment on the '()' field of 'Hi' + -> Int + -> String -- ^ This is a comment on the 'String' field of 'Hi' + -> Hi -- ^ This is a comment on the return type of 'Hi' diff --git a/testsuite/tests/haddock/should_compile_flag_haddock/haddockA035.stderr b/testsuite/tests/haddock/should_compile_flag_haddock/haddockA035.stderr new file mode 100644 index 0000000000..3f12a0cffd --- /dev/null +++ b/testsuite/tests/haddock/should_compile_flag_haddock/haddockA035.stderr @@ -0,0 +1,11 @@ + +==================== Parser ==================== +module Hi where +data Hi + where + Hi :: () " This is a comment on the '()' field of 'Hi'" + -> Int + -> String " This is a comment on the 'String' field of 'Hi'" + -> Hi " This is a comment on the return type of 'Hi'" + + diff --git a/testsuite/tests/haddock/should_compile_flag_haddock/haddockA036.hs b/testsuite/tests/haddock/should_compile_flag_haddock/haddockA036.hs new file mode 100644 index 0000000000..02dd1f9022 --- /dev/null +++ b/testsuite/tests/haddock/should_compile_flag_haddock/haddockA036.hs @@ -0,0 +1,19 @@ +module ConstructorFields where + +data Foo + = Bar Int String -- ^ doc on `Bar` constructor + + | Baz -- ^ doc on the `Baz` constructor + Int -- ^ doc on the `Int` field of `Baz` + String -- ^ doc on the `String` field of `Baz` + + | Int :+ String -- ^ doc on the `:+` constructor + + | Int -- ^ doc on the `Int` field of the `:*` constructor + :* -- ^ doc on the `:*` constructor + String -- ^ doc on the `String` field of the `:*` constructor + + | Boo { x :: () } -- ^ doc on the `Boo` record constructor + + | Boa -- ^ doc on the `Boa` record constructor + { y :: () } diff --git a/testsuite/tests/haddock/should_compile_flag_haddock/haddockA036.stderr b/testsuite/tests/haddock/should_compile_flag_haddock/haddockA036.stderr new file mode 100644 index 0000000000..5cd0a59a05 --- /dev/null +++ b/testsuite/tests/haddock/should_compile_flag_haddock/haddockA036.stderr @@ -0,0 +1,14 @@ + +==================== Parser ==================== +module ConstructorFields where +data Foo + = " doc on `Bar` constructor" Bar Int String | + " doc on the `Baz` constructor" + Baz Int " doc on the `Int` field of `Baz`" String " doc on the `String` field of `Baz`" | + " doc on the `:+` constructor" Int :+ String | + " doc on the `:*` constructor" + Int " doc on the `Int` field of the `:*` constructor" :* String " doc on the `String` field of the `:*` constructor" | + " doc on the `Boo` record constructor" Boo {x :: ()} | + " doc on the `Boa` record constructor" Boa {y :: ()} + + diff --git a/testsuite/tests/haddock/should_compile_flag_haddock/haddockA037.hs b/testsuite/tests/haddock/should_compile_flag_haddock/haddockA037.hs new file mode 100644 index 0000000000..4571e09583 --- /dev/null +++ b/testsuite/tests/haddock/should_compile_flag_haddock/haddockA037.hs @@ -0,0 +1,10 @@ +module UnamedConstructorFields where + +data A = A +data B = B +data C = C + +-- Haddock on 'A' prevents the haddock on 'C' from being applied to 'MkFoo' +data Foo = MkFoo A -- ^ 'A' has a comment + B -- This doesn't + C -- ^ 'C' has a comment diff --git a/testsuite/tests/haddock/should_compile_flag_haddock/haddockA037.stderr b/testsuite/tests/haddock/should_compile_flag_haddock/haddockA037.stderr new file mode 100644 index 0000000000..b9ecfa6303 --- /dev/null +++ b/testsuite/tests/haddock/should_compile_flag_haddock/haddockA037.stderr @@ -0,0 +1,9 @@ + +==================== Parser ==================== +module UnamedConstructorFields where +data A = A +data B = B +data C = C +data Foo = MkFoo A " 'A' has a comment" B C " 'C' has a comment" + + diff --git a/testsuite/tests/haddock/should_compile_flag_haddock/haddockA038.hs b/testsuite/tests/haddock/should_compile_flag_haddock/haddockA038.hs new file mode 100644 index 0000000000..b839bdee22 --- /dev/null +++ b/testsuite/tests/haddock/should_compile_flag_haddock/haddockA038.hs @@ -0,0 +1,14 @@ +module UnamedConstructorStrictFields where +-- See #15206 + +data A = A +data B = B + +data Foo = MkFoo + {-# UNPACK #-} !A -- ^ Unpacked strict field + B + +data Bar = + {-# UNPACK #-} !A -- ^ Unpacked strict field + :%% + B diff --git a/testsuite/tests/haddock/should_compile_flag_haddock/haddockA038.stderr b/testsuite/tests/haddock/should_compile_flag_haddock/haddockA038.stderr new file mode 100644 index 0000000000..3021fa7195 --- /dev/null +++ b/testsuite/tests/haddock/should_compile_flag_haddock/haddockA038.stderr @@ -0,0 +1,7 @@ + +==================== Parser ==================== +module UnamedConstructorStrictFields where +data A = A +data B = B +data Foo = MkFoo {-# UNPACK #-} !A " Unpacked strict field" B +data Bar = {-# UNPACK #-} !A " Unpacked strict field" :%% B diff --git a/testsuite/tests/haddock/should_compile_flag_haddock/haddockA039.hs b/testsuite/tests/haddock/should_compile_flag_haddock/haddockA039.hs new file mode 100644 index 0000000000..79d23e9ec1 --- /dev/null +++ b/testsuite/tests/haddock/should_compile_flag_haddock/haddockA039.hs @@ -0,0 +1,29 @@ +module CommentsBeforeArguments where + +data A = A +data B = B + +f1 :: {-| Comment before -} + () -> + + () + {-^ Comment after -} -> + + () + {-^ Result after -} +f1 _ _ = () + + +f2 :: {-| Comment before -} + () -> + + () + {-^ Comment after -} -> + + {-| Result after -} + () +f2 _ _ = () + + + + diff --git a/testsuite/tests/haddock/should_compile_flag_haddock/haddockA039.stderr b/testsuite/tests/haddock/should_compile_flag_haddock/haddockA039.stderr new file mode 100644 index 0000000000..0c12f5c62f --- /dev/null +++ b/testsuite/tests/haddock/should_compile_flag_haddock/haddockA039.stderr @@ -0,0 +1,11 @@ + +==================== Parser ==================== +module CommentsBeforeArguments where +f1 :: + () Comment before -> () Comment after -> () Result after +f1 _ _ = () +f2 :: + () Comment before -> () Comment after -> () Result after +f2 _ _ = () + + diff --git a/testsuite/tests/haddock/should_compile_noflag_haddock/all.T b/testsuite/tests/haddock/should_compile_noflag_haddock/all.T index c0d62aed43..4e52c2d92c 100644 --- a/testsuite/tests/haddock/should_compile_noflag_haddock/all.T +++ b/testsuite/tests/haddock/should_compile_noflag_haddock/all.T @@ -39,6 +39,10 @@ test('haddockC029', normal, compile, ['']) test('haddockC030', normal, compile, ['']) test('haddockC031', normal, compile, ['-XExistentialQuantification']) test('haddockC032', normal, compile, ['']) +test('haddockC035', normal, compile, ['']) +test('haddockC036', normal, compile, ['']) +test('haddockC037', normal, compile, ['']) +test('haddockC038', normal, compile, ['']) # The tests below this line are not duplicated in # should_compile_flag_haddock. diff --git a/testsuite/tests/haddock/should_compile_noflag_haddock/haddockC035.hs b/testsuite/tests/haddock/should_compile_noflag_haddock/haddockC035.hs new file mode 100644 index 0000000000..25ed2acb83 --- /dev/null +++ b/testsuite/tests/haddock/should_compile_noflag_haddock/haddockC035.hs @@ -0,0 +1,9 @@ +{-# LANGUAGE GADTs #-} + +module Hi where + +data Hi where + Hi :: () -- ^ This is a comment on the '()' field of 'Hi' + -> Int + -> String -- ^ This is a comment on the 'String' field of 'Hi' + -> Hi -- ^ This is a comment on the return type of 'Hi' diff --git a/testsuite/tests/haddock/should_compile_noflag_haddock/haddockC036.hs b/testsuite/tests/haddock/should_compile_noflag_haddock/haddockC036.hs new file mode 100644 index 0000000000..02dd1f9022 --- /dev/null +++ b/testsuite/tests/haddock/should_compile_noflag_haddock/haddockC036.hs @@ -0,0 +1,19 @@ +module ConstructorFields where + +data Foo + = Bar Int String -- ^ doc on `Bar` constructor + + | Baz -- ^ doc on the `Baz` constructor + Int -- ^ doc on the `Int` field of `Baz` + String -- ^ doc on the `String` field of `Baz` + + | Int :+ String -- ^ doc on the `:+` constructor + + | Int -- ^ doc on the `Int` field of the `:*` constructor + :* -- ^ doc on the `:*` constructor + String -- ^ doc on the `String` field of the `:*` constructor + + | Boo { x :: () } -- ^ doc on the `Boo` record constructor + + | Boa -- ^ doc on the `Boa` record constructor + { y :: () } diff --git a/testsuite/tests/haddock/should_compile_noflag_haddock/haddockC037.hs b/testsuite/tests/haddock/should_compile_noflag_haddock/haddockC037.hs new file mode 100644 index 0000000000..4571e09583 --- /dev/null +++ b/testsuite/tests/haddock/should_compile_noflag_haddock/haddockC037.hs @@ -0,0 +1,10 @@ +module UnamedConstructorFields where + +data A = A +data B = B +data C = C + +-- Haddock on 'A' prevents the haddock on 'C' from being applied to 'MkFoo' +data Foo = MkFoo A -- ^ 'A' has a comment + B -- This doesn't + C -- ^ 'C' has a comment diff --git a/testsuite/tests/haddock/should_compile_noflag_haddock/haddockC038.hs b/testsuite/tests/haddock/should_compile_noflag_haddock/haddockC038.hs new file mode 100644 index 0000000000..b839bdee22 --- /dev/null +++ b/testsuite/tests/haddock/should_compile_noflag_haddock/haddockC038.hs @@ -0,0 +1,14 @@ +module UnamedConstructorStrictFields where +-- See #15206 + +data A = A +data B = B + +data Foo = MkFoo + {-# UNPACK #-} !A -- ^ Unpacked strict field + B + +data Bar = + {-# UNPACK #-} !A -- ^ Unpacked strict field + :%% + B diff --git a/testsuite/tests/hpc/T11798.stdout b/testsuite/tests/hpc/T11798.stdout index 024b0dcea3..90142ddd41 100644 --- a/testsuite/tests/hpc/T11798.stdout +++ b/testsuite/tests/hpc/T11798.stdout @@ -1,2 +1,2 @@ [1 of 1] Compiling T11798 ( T11798.hs, T11798.o ) -[1 of 1] Compiling T11798 ( T11798.hs, T11798.o ) [flags changed] +[1 of 1] Compiling T11798 ( T11798.hs, T11798.o ) [HPC flags changed] diff --git a/testsuite/tests/indexed-types/should_compile/CoTest3.hs b/testsuite/tests/indexed-types/should_compile/CoTest3.hs index d57e58c822..b9a825d251 100644 --- a/testsuite/tests/indexed-types/should_compile/CoTest3.hs +++ b/testsuite/tests/indexed-types/should_compile/CoTest3.hs @@ -4,7 +4,7 @@ {-# LANGUAGE GADTs #-} -- This test uses the PushC rule of the System FC operational semantics --- Writen by Tom Schrijvers +-- Written by Tom Schrijvers module CoTest3 where diff --git a/testsuite/tests/indexed-types/should_compile/HO.hs b/testsuite/tests/indexed-types/should_compile/HO.hs index a674469518..dceb4ebef5 100644 --- a/testsuite/tests/indexed-types/should_compile/HO.hs +++ b/testsuite/tests/indexed-types/should_compile/HO.hs @@ -3,9 +3,10 @@ module HO where import Data.IORef +import Data.Kind -type family SMRef (m::(* -> *)) :: * -> * -type family SMMonad (r::(* -> *)) :: * -> * +type family SMRef (m::(Type -> Type)) :: Type -> Type +type family SMMonad (r::(Type -> Type)) :: Type -> Type type instance SMRef IO = IORef type instance SMMonad IORef = IO diff --git a/testsuite/tests/indexed-types/should_compile/Numerals.hs b/testsuite/tests/indexed-types/should_compile/Numerals.hs index 17fb30c3ca..cb3c8e8e56 100644 --- a/testsuite/tests/indexed-types/should_compile/Numerals.hs +++ b/testsuite/tests/indexed-types/should_compile/Numerals.hs @@ -3,8 +3,9 @@ {-# LANGUAGE GADTs #-} {-# LANGUAGE TypeOperators #-} -module Numerals -where +module Numerals where + +import Data.Kind data Z -- empty data type data S a -- empty data type @@ -19,7 +20,7 @@ two = Succ one three = Succ two -- etc...we really would like some nicer syntax here -type family (:+:) n m :: * +type family (:+:) n m :: Type type instance Z :+: m = m type instance (S n) :+: m = S (n :+: m) diff --git a/testsuite/tests/indexed-types/should_compile/PushedInAsGivens.hs b/testsuite/tests/indexed-types/should_compile/PushedInAsGivens.hs index 78f45f5f45..4537d3a21c 100644 --- a/testsuite/tests/indexed-types/should_compile/PushedInAsGivens.hs +++ b/testsuite/tests/indexed-types/should_compile/PushedInAsGivens.hs @@ -15,7 +15,7 @@ bar y = let foo :: (F Int ~ [a]) => a -> Int -- an unsolved wanted as a given and not a given/solved. -- [Wanted] F Int ~ [beta] --- forall a. F Int ~ [a] => a ~ beta --- We we push in the [Wanted] as given, it will interact and solve the implication +-- We push in the [Wanted] as given, it will interact and solve the implication -- constraint, and finally we quantify over F Int ~ [beta]. If we push it in as -- Given/Solved, it will be discarded when we meet the given (F Int ~ [a]) and -- we will not be able to solve the implication constraint. diff --git a/testsuite/tests/indexed-types/should_compile/PushedInAsGivens.stderr b/testsuite/tests/indexed-types/should_compile/PushedInAsGivens.stderr index fa19be483c..5b6863c740 100644 --- a/testsuite/tests/indexed-types/should_compile/PushedInAsGivens.stderr +++ b/testsuite/tests/indexed-types/should_compile/PushedInAsGivens.stderr @@ -1,11 +1,17 @@ PushedInAsGivens.hs:10:31: error: - • Couldn't match expected type ‘a1’ with actual type ‘a’ - because type variable ‘a1’ would escape its scope - This (rigid, skolem) type variable is bound by + • Could not deduce: a1 ~ a + from the context: F Int ~ [a1] + bound by the type signature for: + foo :: forall a1. (F Int ~ [a1]) => a1 -> Int + at PushedInAsGivens.hs:9:13-44 + ‘a1’ is a rigid type variable bound by the type signature for: foo :: forall a1. (F Int ~ [a1]) => a1 -> Int at PushedInAsGivens.hs:9:13-44 + ‘a’ is a rigid type variable bound by + the inferred type of bar :: a -> (a, Int) + at PushedInAsGivens.hs:(9,1)-(11,20) • In the expression: y In the first argument of ‘length’, namely ‘[x, y]’ In the expression: length [x, y] diff --git a/testsuite/tests/indexed-types/should_compile/Simple14.stderr b/testsuite/tests/indexed-types/should_compile/Simple14.stderr index 40d1d90fb7..4c61d95cc9 100644 --- a/testsuite/tests/indexed-types/should_compile/Simple14.stderr +++ b/testsuite/tests/indexed-types/should_compile/Simple14.stderr @@ -3,8 +3,8 @@ Simple14.hs:8:8: error: • Couldn't match type ‘z0’ with ‘z’ ‘z0’ is untouchable inside the constraints: x ~ y - bound by the type signature for: - eqE :: (x ~ y) => EQ_ z0 z0 + bound by a type expected by the context: + (x ~ y) => EQ_ z0 z0 at Simple14.hs:8:8-39 ‘z’ is a rigid type variable bound by the type signature for: diff --git a/testsuite/tests/indexed-types/should_compile/T12369.hs b/testsuite/tests/indexed-types/should_compile/T12369.hs new file mode 100644 index 0000000000..7f4e097ca0 --- /dev/null +++ b/testsuite/tests/indexed-types/should_compile/T12369.hs @@ -0,0 +1,35 @@ +{-# language DataKinds, PolyKinds, GADTs, TypeFamilies, RankNTypes, + TypeOperators, ConstraintKinds #-} + +module T12369 where + +import Data.Kind + +data family Fix :: (k -> Type) -> k +newtype instance Fix f = In { out :: f (Fix f) } + +type FREE k = (k -> Constraint) -> (k -> k) +type f ~> g = forall a. f a -> g a +type f ~~> g = forall a b. f a b -> g a b + +data family Free k :: FREE k + +newtype instance Free Type k p where + Free0 :: (forall q. k q => (p -> q) -> q) -> Free Type k p + +newtype instance Free (j -> Type) k p a where + Free1 :: (forall q. k q => (p ~> q) -> q a) -> Free (j -> Type) k p a + +newtype instance Free (j1 -> j2 -> Type) k p a b where + Free2 :: (forall q. k q => (p ~~> q) -> q a b) -> Free (j1 -> j2 -> Type) k p a b + +data family Free2 :: FREE k + +newtype instance Free2 :: FREE Type where + Free20 :: (forall q. k q => (p -> q) -> q) -> Free2 k p + +newtype instance Free2 :: forall k. FREE (k -> Type) where + Free21 :: (forall q. k q => (p ~> q) -> q a) -> Free2 k p a + +newtype instance Free2 :: forall k1 k2. FREE (k1 -> k2 -> Type) where + Free22 :: (forall q. k q => (p ~~> q) -> q a b) -> Free2 k p a b diff --git a/testsuite/tests/indexed-types/should_compile/T12522b.hs b/testsuite/tests/indexed-types/should_compile/T12522b.hs index 75013823c9..7ed8ae19ff 100644 --- a/testsuite/tests/indexed-types/should_compile/T12522b.hs +++ b/testsuite/tests/indexed-types/should_compile/T12522b.hs @@ -3,15 +3,17 @@ {-# LANGUAGE TypeFamilyDependencies #-} {-# LANGUAGE TypeOperators #-} -module T12522a where +module T12522b where + +import Data.Kind (Type) newtype I a = I a -type family Curry (as :: [*]) b = f | f -> as b where +type family Curry (as :: [Type]) b = f | f -> as b where Curry '[] b = I b Curry (a:as) b = a -> Curry as b -data Uncurried (as :: [*]) b +data Uncurried (as :: [Type]) b def :: Curry as b -> Uncurried as b def = undefined diff --git a/testsuite/tests/indexed-types/should_compile/T12938.hs b/testsuite/tests/indexed-types/should_compile/T12938.hs new file mode 100644 index 0000000000..262a66b406 --- /dev/null +++ b/testsuite/tests/indexed-types/should_compile/T12938.hs @@ -0,0 +1,8 @@ +{-# LANGUAGE PolyKinds, TypeFamilies #-} + +module Bug where + +import GHC.Exts + +class HasRep a where + type Rep a :: TYPE r diff --git a/testsuite/tests/indexed-types/should_compile/T13244.hs b/testsuite/tests/indexed-types/should_compile/T13244.hs index e1a65b99ef..6cfea014a4 100644 --- a/testsuite/tests/indexed-types/should_compile/T13244.hs +++ b/testsuite/tests/indexed-types/should_compile/T13244.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE MagicHash, DataKinds, PolyKinds, TypeInType, TypeFamilies #-} +{-# LANGUAGE MagicHash, DataKinds, PolyKinds, TypeFamilies #-} module T13244 where diff --git a/testsuite/tests/indexed-types/should_compile/T13398b.hs b/testsuite/tests/indexed-types/should_compile/T13398b.hs index 0689ef39d6..703a81763a 100644 --- a/testsuite/tests/indexed-types/should_compile/T13398b.hs +++ b/testsuite/tests/indexed-types/should_compile/T13398b.hs @@ -1,5 +1,5 @@ {-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE TypeInType #-} +{-# LANGUAGE DataKinds, PolyKinds #-} module T13398b where import GHC.TypeLits diff --git a/testsuite/tests/indexed-types/should_compile/T13777.hs b/testsuite/tests/indexed-types/should_compile/T13777.hs new file mode 100644 index 0000000000..7e8b660c4e --- /dev/null +++ b/testsuite/tests/indexed-types/should_compile/T13777.hs @@ -0,0 +1,16 @@ +{-# LANGUAGE GADTs #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE TypeInType #-} +module T13777 where + +import Data.Kind +import Data.Proxy + +data S :: forall k. Proxy k -> Type where + MkS :: S ('Proxy :: Proxy Maybe) + +data T (a :: b) :: forall c (d :: Type) e. + (forall f. Proxy f) -> Proxy c -> Proxy d -> Proxy e + -> Type where + + -- NB: This was originally a failing test, but now that we have #15273, it works! diff --git a/testsuite/tests/indexed-types/should_compile/T14045.hs b/testsuite/tests/indexed-types/should_compile/T14045.hs new file mode 100644 index 0000000000..951388bfce --- /dev/null +++ b/testsuite/tests/indexed-types/should_compile/T14045.hs @@ -0,0 +1,10 @@ +{-# LANGUAGE TypeFamilies, PolyKinds, DataKinds, GADTs #-} + +module T14045 where + +import Data.Kind + +data family Sing (a :: k) +data instance Sing :: Bool -> Type where + SFalse :: Sing False + STrue :: Sing True diff --git a/testsuite/tests/indexed-types/should_compile/T14131.hs b/testsuite/tests/indexed-types/should_compile/T14131.hs new file mode 100644 index 0000000000..e8b15790a1 --- /dev/null +++ b/testsuite/tests/indexed-types/should_compile/T14131.hs @@ -0,0 +1,29 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE TypeFamilies #-} +module T14131 where + +import Data.Kind +import Data.Proxy + +data family Nat :: k -> k -> * +newtype instance Nat :: (k -> *) -> (k -> *) -> * where + Nat :: (forall xx. f xx -> g xx) -> Nat f g + +type family F :: Maybe a +type instance F = (Nothing :: Maybe a) + +class C k where + data CD :: k -> k -> * + type CT :: k + +instance C (Maybe a) where + data CD :: Maybe a -> Maybe a -> * where + CD :: forall (m :: Maybe a) (n :: Maybe a). Proxy m -> Proxy n -> CD m n + type CT = (Nothing :: Maybe a) + +class Z k where + type ZT :: Maybe k + type ZT = (Nothing :: Maybe k) diff --git a/testsuite/tests/indexed-types/should_compile/T14162.hs b/testsuite/tests/indexed-types/should_compile/T14162.hs new file mode 100644 index 0000000000..1eccbffc86 --- /dev/null +++ b/testsuite/tests/indexed-types/should_compile/T14162.hs @@ -0,0 +1,42 @@ +{-# Language TypeOperators, KindSignatures, DataKinds, PolyKinds, + TypeFamilies, GADTs #-} + +module T14162 where + +import Data.Kind + +data SubList (a :: Maybe w) :: Type where + SubNil :: SubList 'Nothing + +data family Sing (a :: k) + +data instance Sing (x :: SubList ys) where + SSubNil :: Sing SubNil + +{- +SubList :: forall (w::*). Maybe w -> * +SubNil :: forall (w::*). SubList w (Nothing w) + +wrkSubNil :: forall (w::*) (a :: Maybe w). + (a ~ Nothing w) => + SubList w a + +Sing :: forall k. k -> * + +RepTc :: forall (w_aSy : *) + (ys_aRW :: Maybe w_aSy) + (x_aRX :: SubList w_aSy ys_aRW). + * + +axiom forall (w : *) (ys : Maybe w) (x : SubList ys). + Sing (SubList ys) (x : SubList ys) ~ RepTc w ys x + +data RepTc w ys x where + SSubNil :: RepTc w (Nothing w) (SubNil w) + +SSubNil :: forall (w :: *). Sing (SubList w (Nothing w)) (SubNil w) + +wrkSSubMil :: forall (w : *) (ys : Maybe w) (x : Sublist w ys). + () => + RepTc w ys x +-} diff --git a/testsuite/tests/indexed-types/should_compile/T14164.hs b/testsuite/tests/indexed-types/should_compile/T14164.hs new file mode 100644 index 0000000000..1cf6f2d78b --- /dev/null +++ b/testsuite/tests/indexed-types/should_compile/T14164.hs @@ -0,0 +1,10 @@ +{-# LANGUAGE TypeFamilyDependencies #-}
+{-# LANGUAGE TypeInType #-}
+{-# LANGUAGE TypeOperators #-}
+module T14164 where
+
+data G (x :: a) = GNil | GCons (G x)
+
+type family F (xs :: [a]) (g :: G (z :: a)) = (res :: [a]) | res -> a where
+ F (x:xs) GNil = x:xs
+ F (x:xs) (GCons rest) = x:F xs rest
diff --git a/testsuite/tests/indexed-types/should_compile/T14237.hs b/testsuite/tests/indexed-types/should_compile/T14237.hs new file mode 100644 index 0000000000..cab9fd2052 --- /dev/null +++ b/testsuite/tests/indexed-types/should_compile/T14237.hs @@ -0,0 +1,7 @@ +{-# LANGUAGE TypeFamilies #-} +{-# OPTIONS_GHC -fwarn-redundant-constraints #-} + +module T14237 where + +f :: (Integer ~ a) => a -> Integer +f = (+ 1) diff --git a/testsuite/tests/indexed-types/should_compile/T14554.hs b/testsuite/tests/indexed-types/should_compile/T14554.hs new file mode 100644 index 0000000000..6049b1934e --- /dev/null +++ b/testsuite/tests/indexed-types/should_compile/T14554.hs @@ -0,0 +1,33 @@ +{-# Language UndecidableInstances, DataKinds, TypeOperators, TypeFamilies, + PolyKinds, GADTs, LambdaCase, ScopedTypeVariables #-} + +module T14554 where + +import Data.Kind +import Data.Proxy + +type a ~> b = (a, b) -> Type + +data IdSym0 :: (Type,Type) -> Type + +data KIND = X | FNARR KIND KIND + +data TY :: KIND -> Type where + ID :: TY (FNARR X X) + FNAPP :: TY (FNARR k k') -> TY k -> TY k' + +data TyRep (kind::KIND) :: TY kind -> Type where + TID :: TyRep (FNARR X X) ID + TFnApp :: TyRep (FNARR k k') f + -> TyRep k a + -> TyRep k' (FNAPP f a) + +type family IK (kind::KIND) :: Type where + IK X = Type + IK (FNARR k k') = IK k ~> IK k' + +type family IT (ty::TY kind) :: IK kind + +zero :: TyRep X a -> IT a +zero x = case x of + TFnApp TID a -> undefined diff --git a/testsuite/tests/indexed-types/should_compile/T14680.hs b/testsuite/tests/indexed-types/should_compile/T14680.hs new file mode 100644 index 0000000000..9694c0a2ea --- /dev/null +++ b/testsuite/tests/indexed-types/should_compile/T14680.hs @@ -0,0 +1,19 @@ +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE TypeFamilies #-} +{-# OPTIONS_GHC -O1 #-} +module T14680 where + +import GHC.Base (getTag) +import GHC.Exts (Int(..), tagToEnum#) + +data family TyFamilyEnum +data instance TyFamilyEnum = TyFamilyEnum1 | TyFamilyEnum2 | TyFamilyEnum3 + +suc :: TyFamilyEnum -> TyFamilyEnum +suc a_aaf8 + = case getTag a_aaf8 of + a_aaf9 + -> if 2 == I# a_aaf9 + then error "succ{TyFamilyEnum}: tried to take `succ' of last tag in enumeration" + else case I# a_aaf9 + 1 of + I# i_aafa -> tagToEnum# i_aafa :: TyFamilyEnum diff --git a/testsuite/tests/indexed-types/should_compile/T15057.hs b/testsuite/tests/indexed-types/should_compile/T15057.hs new file mode 100644 index 0000000000..b21d3e37f9 --- /dev/null +++ b/testsuite/tests/indexed-types/should_compile/T15057.hs @@ -0,0 +1,11 @@ +{-# LANGUAGE LiberalTypeSynonyms #-} +{-# LANGUAGE TypeFamilies #-} +module T15057 where + +type T f = f Int +type S a = a -> a + +type family TF a +type instance TF Int = T S + -- Ensure that -dcore-lint doesn't trip up on this unsaturated use + -- of the type synonym S diff --git a/testsuite/tests/indexed-types/should_compile/T15122.hs b/testsuite/tests/indexed-types/should_compile/T15122.hs new file mode 100644 index 0000000000..c05bd3a8a0 --- /dev/null +++ b/testsuite/tests/indexed-types/should_compile/T15122.hs @@ -0,0 +1,16 @@ +{-# LANGUAGE GADTs #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeInType #-} +module T15122 where + +import Data.Kind +import Data.Proxy + +data IsStar (a :: k) where + IsStar :: IsStar (a :: Type) + +type family F (a :: k) :: k + +foo :: (F a ~ F b) => IsStar a -> Proxy b + -> Proxy (F a) -> Proxy (F b) +foo IsStar _ p = p diff --git a/testsuite/tests/indexed-types/should_compile/T15142.hs b/testsuite/tests/indexed-types/should_compile/T15142.hs new file mode 100644 index 0000000000..0109ef543d --- /dev/null +++ b/testsuite/tests/indexed-types/should_compile/T15142.hs @@ -0,0 +1,14 @@ +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeInType #-} + + +module T15142 where + +import Data.Kind + +class ListTuple (tuple :: Type) (as :: [(k, Type)]) where + type ListToTuple as :: Type + +class C (a :: Type) (b :: k) where + type T b diff --git a/testsuite/tests/indexed-types/should_compile/T15144.hs b/testsuite/tests/indexed-types/should_compile/T15144.hs new file mode 100644 index 0000000000..c6f0856184 --- /dev/null +++ b/testsuite/tests/indexed-types/should_compile/T15144.hs @@ -0,0 +1,18 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE TypeFamilies #-} +module T15144 where + +import Data.Coerce +import Data.Proxy + +type family F x + +f :: Coercible (F a) b => Proxy a -> F a -> b +f _ = coerce + +-- In #15144, we inferred the less-general type +-- g :: Proxy a -> F a -> F a +g p x = f p x + +h :: Coercible (F a) b => Proxy a -> F a -> b +h p x = g p x diff --git a/testsuite/tests/indexed-types/should_compile/T15318.hs b/testsuite/tests/indexed-types/should_compile/T15318.hs new file mode 100644 index 0000000000..342b6ef42d --- /dev/null +++ b/testsuite/tests/indexed-types/should_compile/T15318.hs @@ -0,0 +1,8 @@ +{-# LANGUAGE GADTs #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeFamilies #-} +module T15138 where + +data family Sn a +newtype instance Sn (Either a b) where + SnC :: forall b a. Char -> Sn (Either a b) diff --git a/testsuite/tests/indexed-types/should_compile/T15322.hs b/testsuite/tests/indexed-types/should_compile/T15322.hs new file mode 100644 index 0000000000..5a0cd179b8 --- /dev/null +++ b/testsuite/tests/indexed-types/should_compile/T15322.hs @@ -0,0 +1,12 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE ScopedTypeVariables, FlexibleContexts #-} +{-# LANGUAGE TypeOperators #-} + +module T15322 where + +import Data.Proxy (Proxy (..)) +import Type.Reflection +import GHC.TypeLits (KnownNat, type (+)) + +f :: forall n . (Typeable (n+1), KnownNat n) => Proxy n -> TypeRep (n+1) +f _ = typeRep diff --git a/testsuite/tests/indexed-types/should_compile/T15322.stderr b/testsuite/tests/indexed-types/should_compile/T15322.stderr new file mode 100644 index 0000000000..7447a9ece2 --- /dev/null +++ b/testsuite/tests/indexed-types/should_compile/T15322.stderr @@ -0,0 +1,8 @@ + +T15322.hs:11:6: warning: [-Wsimplifiable-class-constraints (in -Wdefault)] + • The constraint ‘Typeable (n + 1)’ matches a built-in instance + This makes type inference for inner bindings fragile; + either use MonoLocalBinds, or simplify it using the instance + • In the type signature: + f :: forall n. + (Typeable (n + 1), KnownNat n) => Proxy n -> TypeRep (n + 1) diff --git a/testsuite/tests/indexed-types/should_compile/T15322a.hs b/testsuite/tests/indexed-types/should_compile/T15322a.hs new file mode 100644 index 0000000000..93d0830b26 --- /dev/null +++ b/testsuite/tests/indexed-types/should_compile/T15322a.hs @@ -0,0 +1,12 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE ScopedTypeVariables, FlexibleContexts #-} +{-# LANGUAGE TypeOperators #-} + +module T15322a where + +import Data.Proxy (Proxy (..)) +import Type.Reflection +import GHC.TypeLits (KnownNat, type (+)) + +f :: forall n . (KnownNat n) => Proxy n -> TypeRep (n+1) +f _ = typeRep diff --git a/testsuite/tests/indexed-types/should_compile/T15322a.stderr b/testsuite/tests/indexed-types/should_compile/T15322a.stderr new file mode 100644 index 0000000000..37a9070e27 --- /dev/null +++ b/testsuite/tests/indexed-types/should_compile/T15322a.stderr @@ -0,0 +1,12 @@ + +T15322a.hs:12:7: error: + • Could not deduce (KnownNat (n + 1)) + arising from a use of ‘typeRep’ + from the context: KnownNat n + bound by the type signature for: + f :: forall (n :: GHC.Types.Nat). + KnownNat n => + Proxy n -> TypeRep (n + 1) + at T15322a.hs:11:1-56 + • In the expression: typeRep + In an equation for ‘f’: f _ = typeRep diff --git a/testsuite/tests/indexed-types/should_compile/T15352.hs b/testsuite/tests/indexed-types/should_compile/T15352.hs new file mode 100644 index 0000000000..d83512f085 --- /dev/null +++ b/testsuite/tests/indexed-types/should_compile/T15352.hs @@ -0,0 +1,31 @@ +{-# LANGUAGE TypeInType #-} -- or PolyKinds +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE TypeFamilies #-} + +module T15352 where + +import Data.Kind + +class C (x :: Type) (y :: k) where + type F y + + +type Hom k = k -> k -> Type + +type family Ob (p :: Hom k) :: k -> Constraint + +class ( obP ~ Ob p + , opP ~ Dom p + , obQ ~ Ob q + , opQ ~ Dom q + , p ~ Dom f + , q ~ Cod f + ) => Functor' (obP :: i -> Constraint) + (opP :: Hom i) + (p :: Hom i) + (obQ :: j -> Constraint) + (opQ :: Hom j) + (q :: Hom j) + (f :: i -> j) where + type Dom f :: Hom i + type Cod f :: Hom j diff --git a/testsuite/tests/indexed-types/should_compile/T2219.hs b/testsuite/tests/indexed-types/should_compile/T2219.hs index ea7d442f74..9778524a7a 100644 --- a/testsuite/tests/indexed-types/should_compile/T2219.hs +++ b/testsuite/tests/indexed-types/should_compile/T2219.hs @@ -2,6 +2,8 @@ module Test where +import Data.Kind (Type) + data Zero data Succ a @@ -15,7 +17,7 @@ data Fin n fn where data Nil data a ::: b -type family Lookup ts fn :: * +type family Lookup ts fn :: Type type instance Lookup (t ::: ts) FZ = t type instance Lookup (t ::: ts) (FS fn) = Lookup ts fn diff --git a/testsuite/tests/indexed-types/should_compile/T3017.stderr b/testsuite/tests/indexed-types/should_compile/T3017.stderr index 37430bbb2a..5aaf3ceedf 100644 --- a/testsuite/tests/indexed-types/should_compile/T3017.stderr +++ b/testsuite/tests/indexed-types/should_compile/T3017.stderr @@ -4,7 +4,7 @@ TYPE SIGNATURES emptyL :: forall a. ListColl a insert :: forall c. Coll c => Elem c -> c -> c test2 :: - forall c a b. (Elem c ~ (a, b), Num b, Num a, Coll c) => c -> c + forall c a b. (Coll c, Num a, Num b, Elem c ~ (a, b)) => c -> c TYPE CONSTRUCTORS class Coll c where type family Elem c :: * open @@ -20,5 +20,5 @@ INSTANCES FAMILY INSTANCES type Elem (ListColl a) Dependent modules: [] -Dependent packages: [base-4.10.0.0, ghc-prim-0.5.1.0, - integer-gmp-1.0.0.1] +Dependent packages: [base-4.12.0.0, ghc-prim-0.5.3, + integer-gmp-1.0.2.0] diff --git a/testsuite/tests/indexed-types/should_compile/T7585.hs b/testsuite/tests/indexed-types/should_compile/T7585.hs index a21c04dbf7..2cf23d267e 100644 --- a/testsuite/tests/indexed-types/should_compile/T7585.hs +++ b/testsuite/tests/indexed-types/should_compile/T7585.hs @@ -3,11 +3,13 @@ module Bug where -data SBool :: Bool -> * where +import Data.Kind + +data SBool :: Bool -> Type where SFalse :: SBool False STrue :: SBool True -data SList :: [Bool] -> * where +data SList :: [Bool] -> Type where SNil :: SList '[] SCons :: SBool h -> SList t -> SList (h ': t) @@ -17,4 +19,4 @@ type family (a :: [k]) :==: (b :: [k]) :: Bool where a :==: b = False (%==%) :: SList ls1 -> SList ls2 -> SBool (ls1 :==: ls2) -SNil %==% (SCons _ _) = SFalse
\ No newline at end of file +SNil %==% (SCons _ _) = SFalse diff --git a/testsuite/tests/indexed-types/should_fail/T7786.hs b/testsuite/tests/indexed-types/should_compile/T7786.hs index 2a5c7f5983..33a74f233f 100644 --- a/testsuite/tests/indexed-types/should_fail/T7786.hs +++ b/testsuite/tests/indexed-types/should_compile/T7786.hs @@ -4,7 +4,9 @@ FlexibleContexts, ScopedTypeVariables #-} module T7786 where +import Data.Kind (Type) import GHC.TypeLits(Symbol,Nat) + data family Sing (a :: k) data Inventory a = Empty | More (Inventory a) a @@ -33,7 +35,7 @@ under Root' post = post under (Symic'' ks k) post = under ks post `Symic''` k under (Numic'' ks k) post = under ks post `Numic''` k -data Database :: Inventory [KeySegment] -> * where +data Database :: Inventory [KeySegment] -> Type where Clean :: Database Empty Record :: (k `KeyNotIn` i) => Database i -> Sing k -> () -> Database (More i k) Sub :: ((sub `UnderDisjoint` k) i) => Database i -> Sing k -> Database sub -> Database ((sub `BuriedUnder` k) i) diff --git a/testsuite/tests/indexed-types/should_compile/T7837.stderr b/testsuite/tests/indexed-types/should_compile/T7837.stderr index eb682613b9..dec839f72b 100644 --- a/testsuite/tests/indexed-types/should_compile/T7837.stderr +++ b/testsuite/tests/indexed-types/should_compile/T7837.stderr @@ -1,5 +1,7 @@ Rule fired: Class op signum (BUILTIN) Rule fired: Class op abs (BUILTIN) -Rule fired: Class op HEq_sc (BUILTIN) Rule fired: normalize/Double (T7837) -Rule fired: Class op HEq_sc (BUILTIN) +Rule fired: Class op eq_sel (BUILTIN) +Rule fired: Class op $p1Norm (BUILTIN) +Rule fired: Class op / (BUILTIN) +Rule fired: Class op norm (BUILTIN) diff --git a/testsuite/tests/indexed-types/should_compile/T8889.stderr b/testsuite/tests/indexed-types/should_compile/T8889.stderr index cef00dfb97..551ced73a0 100644 --- a/testsuite/tests/indexed-types/should_compile/T8889.stderr +++ b/testsuite/tests/indexed-types/should_compile/T8889.stderr @@ -1,4 +1,4 @@ T8889.hs:12:1: warning: [-Wmissing-signatures (in -Wall)] Top-level binding with no type signature: - f :: (C f, C_fmap f a) => (a -> b) -> f a -> f b + f :: (C_fmap f a, C f) => (a -> b) -> f a -> f b diff --git a/testsuite/tests/indexed-types/should_compile/T9747.hs b/testsuite/tests/indexed-types/should_compile/T9747.hs index 3b1c47703e..aefffd55f6 100644 --- a/testsuite/tests/indexed-types/should_compile/T9747.hs +++ b/testsuite/tests/indexed-types/should_compile/T9747.hs @@ -4,13 +4,14 @@ module T9747 where import Data.List (intercalate) import Data.Proxy -import GHC.Exts (Constraint) +import Data.Kind (Type, Constraint) -data HList :: [*] -> * where +data HList :: [Type] -> Type where Nil :: HList '[] Cons :: a -> HList as -> HList (a ': as) -type family HListAll (c :: * -> Constraint) (ts :: [*]) :: Constraint where +type family HListAll (c :: Type -> Constraint) + (ts :: [Type]) :: Constraint where HListAll c '[] = () HListAll c (t ': ts) = (c t, HListAll c ts) @@ -27,7 +28,7 @@ test = showHList (Cons (2::Int) (Cons (3.1 :: Float) (Cons 'c' Nil))) -type family ConFun (t :: *) :: * -> Constraint +type family ConFun (t :: Type) :: Type -> Constraint data Tag type instance ConFun Tag = Group diff --git a/testsuite/tests/indexed-types/should_compile/all.T b/testsuite/tests/indexed-types/should_compile/all.T index ec55113e6b..11b7bcbc16 100644 --- a/testsuite/tests/indexed-types/should_compile/all.T +++ b/testsuite/tests/indexed-types/should_compile/all.T @@ -131,7 +131,7 @@ test('IndTypesPerf', ['$MAKE -s --no-print-directory IndTypesPerf']) test('T4120', normal, compile, ['']) -test('T3787', reqlib('mtl'), compile, ['']) +test('T3787', normal, compile, ['']) test('T3826', normal, compile, ['']) test('T4200', normal, compile, ['']) test('T3851', normal, compile, ['']) @@ -192,8 +192,14 @@ test('T7489', normal, compile, ['']) test('T7585', normal, compile, ['']) test('T7282', normal, compile, ['']) test('T7804', normal, compile, ['']) -test('T7837', expect_broken_for(9406, prof_ways), compile, + +# This test has sometimes been marked as +# expect_broken_for(9406, prof_ways), +# so ticket #9406 can be used to track +# future failures as well. +test('T7837', normal, compile, ['-O -ddump-rule-firings']) + test('T4185', normal, compile, ['']) # Caused infinite loop in the compiler @@ -265,3 +271,22 @@ test('T13398a', normal, compile, ['']) test('T13398b', normal, compile, ['']) test('T13662', normal, compile, ['']) test('T13705', normal, compile, ['']) +test('T12369', normal, compile, ['']) +test('T14045', normal, compile, ['']) +test('T12938', normal, compile, ['']) +test('T14131', normal, compile, ['']) +test('T14162', normal, compile, ['']) +test('T14237', normal, compile, ['']) +test('T14554', normal, compile, ['']) +test('T14680', normal, compile, ['']) +test('T15057', normal, compile, ['']) +test('T7786', normal, compile, ['']) +test('T15144', normal, compile, ['']) +test('T15122', normal, compile, ['']) +test('T13777', normal, compile, ['']) +test('T14164', normal, compile, ['']) +test('T15318', normal, compile, ['']) +test('T15322', normal, compile, ['']) +test('T15322a', normal, compile_fail, ['']) +test('T15142', normal, compile, ['']) +test('T15352', normal, compile, ['']) diff --git a/testsuite/tests/indexed-types/should_fail/ClosedFam3.stderr b/testsuite/tests/indexed-types/should_fail/ClosedFam3.stderr index ba1f46ef47..cab50784e1 100644 --- a/testsuite/tests/indexed-types/should_fail/ClosedFam3.stderr +++ b/testsuite/tests/indexed-types/should_fail/ClosedFam3.stderr @@ -27,5 +27,5 @@ ClosedFam3.hs-boot:12:1: error: Main module: type family Baz a :: * where Baz Int = Bool Boot file: type family Baz (a :: k) :: * - where Baz * Int = Bool + where Baz Int = Bool The types have different kinds diff --git a/testsuite/tests/indexed-types/should_fail/Makefile b/testsuite/tests/indexed-types/should_fail/Makefile index d56889e566..432003c9df 100644 --- a/testsuite/tests/indexed-types/should_fail/Makefile +++ b/testsuite/tests/indexed-types/should_fail/Makefile @@ -14,5 +14,5 @@ T8227: # an asertion failure with -ddump-tc-trace T8129: -'$(TEST_HC)' $(TEST_HC_OPTS) -c -ddump-tc-trace T8129.hs 2> T8129.trace > T8129.trace - grep deduce T8129.trace + grep -a deduce T8129.trace diff --git a/testsuite/tests/indexed-types/should_fail/NoMatchErr.stderr b/testsuite/tests/indexed-types/should_fail/NoMatchErr.stderr index 7a553f301c..9eab513529 100644 --- a/testsuite/tests/indexed-types/should_fail/NoMatchErr.stderr +++ b/testsuite/tests/indexed-types/should_fail/NoMatchErr.stderr @@ -3,9 +3,8 @@ NoMatchErr.hs:19:7: error: • Couldn't match type ‘Memo d0’ with ‘Memo d’ Expected type: Memo d a -> Memo d a Actual type: Memo d0 a -> Memo d0 a - NB: ‘Memo’ is a type function, and may not be injective + NB: ‘Memo’ is a non-injective type family The type variable ‘d0’ is ambiguous • In the ambiguity check for ‘f’ To defer the ambiguity check to use sites, enable AllowAmbiguousTypes - In the type signature: - f :: (Fun d) => Memo d a -> Memo d a + In the type signature: f :: (Fun d) => Memo d a -> Memo d a diff --git a/testsuite/tests/indexed-types/should_fail/NotRelaxedExamples.stderr b/testsuite/tests/indexed-types/should_fail/NotRelaxedExamples.stderr index 8664c7ba7b..500be78a5f 100644 --- a/testsuite/tests/indexed-types/should_fail/NotRelaxedExamples.stderr +++ b/testsuite/tests/indexed-types/should_fail/NotRelaxedExamples.stderr @@ -6,12 +6,12 @@ NotRelaxedExamples.hs:9:15: error: NotRelaxedExamples.hs:10:15: error: • The type family application ‘F2 [x]’ - is no smaller than the instance head + is no smaller than the instance head ‘F2 [x]’ (Use UndecidableInstances to permit this) • In the type instance declaration for ‘F2’ NotRelaxedExamples.hs:11:15: error: • The type family application ‘F3 [Char]’ - is no smaller than the instance head + is no smaller than the instance head ‘F3 Bool’ (Use UndecidableInstances to permit this) • In the type instance declaration for ‘F3’ diff --git a/testsuite/tests/indexed-types/should_fail/Over.stderr b/testsuite/tests/indexed-types/should_fail/Over.stderr index 63b8b304b2..3e0bc44b57 100644 --- a/testsuite/tests/indexed-types/should_fail/Over.stderr +++ b/testsuite/tests/indexed-types/should_fail/Over.stderr @@ -1,8 +1,8 @@ OverB.hs:7:15: error: Conflicting family instance declarations: - C [Int] [a] = CListList2 -- Defined at OverB.hs:7:15 - C [a] [Int] = C9ListList -- Defined at OverC.hs:7:15 + C [Int] [a] -- Defined at OverB.hs:7:15 + C [a] [Int] -- Defined at OverC.hs:7:15 OverB.hs:9:15: error: Conflicting family instance declarations: diff --git a/testsuite/tests/indexed-types/should_fail/OverDirectThisMod.stderr b/testsuite/tests/indexed-types/should_fail/OverDirectThisMod.stderr index 28c72df6e0..99a3377eb0 100644 --- a/testsuite/tests/indexed-types/should_fail/OverDirectThisMod.stderr +++ b/testsuite/tests/indexed-types/should_fail/OverDirectThisMod.stderr @@ -1,8 +1,8 @@ OverDirectThisModB.hs:7:15: error: Conflicting family instance declarations: - C [Int] [a] = CListList2 -- Defined at OverDirectThisModB.hs:7:15 - C [a] [Int] = C9ListList -- Defined at OverDirectThisModC.hs:10:15 + C [Int] [a] -- Defined at OverDirectThisModB.hs:7:15 + C [a] [Int] -- Defined at OverDirectThisModC.hs:10:15 OverDirectThisModB.hs:9:15: error: Conflicting family instance declarations: diff --git a/testsuite/tests/indexed-types/should_fail/OverIndirectThisMod.stderr b/testsuite/tests/indexed-types/should_fail/OverIndirectThisMod.stderr index 53c93e80ce..af136704db 100644 --- a/testsuite/tests/indexed-types/should_fail/OverIndirectThisMod.stderr +++ b/testsuite/tests/indexed-types/should_fail/OverIndirectThisMod.stderr @@ -1,10 +1,8 @@ OverIndirectThisModB.hs:7:15: error: Conflicting family instance declarations: - C [Int] [a] = OverIndirectThisModB.CListList2 - -- Defined at OverIndirectThisModB.hs:7:15 - C [a] [Int] = C9ListList - -- Defined at OverIndirectThisModD.hs:11:15 + C [Int] [a] -- Defined at OverIndirectThisModB.hs:7:15 + C [a] [Int] -- Defined at OverIndirectThisModD.hs:11:15 OverIndirectThisModB.hs:9:15: error: Conflicting family instance declarations: diff --git a/testsuite/tests/indexed-types/should_fail/Overlap4.stderr b/testsuite/tests/indexed-types/should_fail/Overlap4.stderr index 937a18d861..53dc8b4ac0 100644 --- a/testsuite/tests/indexed-types/should_fail/Overlap4.stderr +++ b/testsuite/tests/indexed-types/should_fail/Overlap4.stderr @@ -1,6 +1,4 @@ -Overlap4.hs:7:12: error: - • Expecting one more argument to ‘Maybe’ - Expected a type, but ‘Maybe’ has kind ‘* -> *’ - • In the type ‘Maybe’ - In the type family declaration for ‘F’ +Overlap4.hs:7:3: error: + • Number of parameters must match family declaration; expected 2 + • In the type family declaration for ‘F’ diff --git a/testsuite/tests/indexed-types/should_fail/SimpleFail11a.stderr b/testsuite/tests/indexed-types/should_fail/SimpleFail11a.stderr index d467019760..41ed865dfb 100644 --- a/testsuite/tests/indexed-types/should_fail/SimpleFail11a.stderr +++ b/testsuite/tests/indexed-types/should_fail/SimpleFail11a.stderr @@ -1,10 +1,10 @@ -SimpleFail11a.hs:6:15: +SimpleFail11a.hs:6:15: error: Conflicting family instance declarations: - C9 Int Int = C9IntInt -- Defined at SimpleFail11a.hs:6:15 - C9 Int Int = C9IntInt2 -- Defined at SimpleFail11a.hs:8:15 + C9 Int Int -- Defined at SimpleFail11a.hs:6:15 + C9 Int Int -- Defined at SimpleFail11a.hs:8:15 -SimpleFail11a.hs:11:15: +SimpleFail11a.hs:11:15: error: Conflicting family instance declarations: D9 Int Int = Char -- Defined at SimpleFail11a.hs:11:15 D9 Int Int = Int -- Defined at SimpleFail11a.hs:13:15 diff --git a/testsuite/tests/indexed-types/should_fail/SimpleFail11b.stderr b/testsuite/tests/indexed-types/should_fail/SimpleFail11b.stderr index e40a3a6b4e..bd05039dc8 100644 --- a/testsuite/tests/indexed-types/should_fail/SimpleFail11b.stderr +++ b/testsuite/tests/indexed-types/should_fail/SimpleFail11b.stderr @@ -1,10 +1,10 @@ -SimpleFail11b.hs:7:15: +SimpleFail11b.hs:7:15: error: Conflicting family instance declarations: - C9 [a] Int = C9ListInt -- Defined at SimpleFail11b.hs:7:15 - C9 [a] Int = C9ListInt2 -- Defined at SimpleFail11b.hs:9:15 + C9 [a] Int -- Defined at SimpleFail11b.hs:7:15 + C9 [a] Int -- Defined at SimpleFail11b.hs:9:15 -SimpleFail11b.hs:13:15: +SimpleFail11b.hs:13:15: error: Conflicting family instance declarations: D9 [a] Int = [a] -- Defined at SimpleFail11b.hs:13:15 D9 [a] Int = Maybe a -- Defined at SimpleFail11b.hs:15:15 diff --git a/testsuite/tests/indexed-types/should_fail/SimpleFail11c.stderr b/testsuite/tests/indexed-types/should_fail/SimpleFail11c.stderr index d4a1bb4f30..cbb457933b 100644 --- a/testsuite/tests/indexed-types/should_fail/SimpleFail11c.stderr +++ b/testsuite/tests/indexed-types/should_fail/SimpleFail11c.stderr @@ -1,10 +1,10 @@ -SimpleFail11c.hs:7:15: +SimpleFail11c.hs:7:15: error: Conflicting family instance declarations: - C9 [a] Int = C9ListInt -- Defined at SimpleFail11c.hs:7:15 - C9 [Int] Int = C9ListInt2 -- Defined at SimpleFail11c.hs:9:15 + C9 [a] Int -- Defined at SimpleFail11c.hs:7:15 + C9 [Int] Int -- Defined at SimpleFail11c.hs:9:15 -SimpleFail11c.hs:13:15: +SimpleFail11c.hs:13:15: error: Conflicting family instance declarations: D9 [a] Int = [a] -- Defined at SimpleFail11c.hs:13:15 D9 [Int] Int = [Bool] -- Defined at SimpleFail11c.hs:15:15 diff --git a/testsuite/tests/indexed-types/should_fail/SimpleFail11d.stderr b/testsuite/tests/indexed-types/should_fail/SimpleFail11d.stderr index cdd8afda96..48d3c33fef 100644 --- a/testsuite/tests/indexed-types/should_fail/SimpleFail11d.stderr +++ b/testsuite/tests/indexed-types/should_fail/SimpleFail11d.stderr @@ -1,5 +1,5 @@ -SimpleFail11d.hs:8:15: +SimpleFail11d.hs:8:15: error: Conflicting family instance declarations: - C9 [Int] [a] = C9ListList2 -- Defined at SimpleFail11d.hs:8:15 - C9 [a] [Int] = C9ListList -- Defined at SimpleFail11d.hs:10:15 + C9 [Int] [a] -- Defined at SimpleFail11d.hs:8:15 + C9 [a] [Int] -- Defined at SimpleFail11d.hs:10:15 diff --git a/testsuite/tests/indexed-types/should_fail/SimpleFail13.stderr b/testsuite/tests/indexed-types/should_fail/SimpleFail13.stderr index 6cb6fe0e50..cfbab576b9 100644 --- a/testsuite/tests/indexed-types/should_fail/SimpleFail13.stderr +++ b/testsuite/tests/indexed-types/should_fail/SimpleFail13.stderr @@ -1,8 +1,10 @@ -SimpleFail13.hs:9:1: - Illegal type synonym family application in instance: [C a] - In the data instance declaration for ‘D’ +SimpleFail13.hs:9:1: error: + • Illegal type synonym family application ‘C a’ in instance: + D [C a] + • In the data instance declaration for ‘D’ -SimpleFail13.hs:13:15: - Illegal type synonym family application in instance: [C a] - In the type instance declaration for ‘E’ +SimpleFail13.hs:13:15: error: + • Illegal type synonym family application ‘C a’ in instance: + E [C a] + • In the type instance declaration for ‘E’ diff --git a/testsuite/tests/indexed-types/should_fail/SimpleFail1a.stderr b/testsuite/tests/indexed-types/should_fail/SimpleFail1a.stderr index b0c91af91a..8637eaa892 100644 --- a/testsuite/tests/indexed-types/should_fail/SimpleFail1a.stderr +++ b/testsuite/tests/indexed-types/should_fail/SimpleFail1a.stderr @@ -1,4 +1,5 @@ SimpleFail1a.hs:4:1: error: - • Number of parameters must match family declaration; expected 2 + • Expecting one more argument to ‘T1 Int’ + Expected a type, but ‘T1 Int’ has kind ‘* -> *’ • In the data instance declaration for ‘T1’ diff --git a/testsuite/tests/indexed-types/should_fail/SimpleFail1b.stderr b/testsuite/tests/indexed-types/should_fail/SimpleFail1b.stderr index e872f115a2..32303ecccb 100644 --- a/testsuite/tests/indexed-types/should_fail/SimpleFail1b.stderr +++ b/testsuite/tests/indexed-types/should_fail/SimpleFail1b.stderr @@ -1,6 +1,4 @@ -SimpleFail1b.hs:4:1: - Too many parameters to T1: - Char is unexpected; - expected only two parameters - In the data instance declaration for ‘T1’ +SimpleFail1b.hs:4:1: error: + • Expected kind ‘* -> *’, but ‘T1 Int Bool’ has kind ‘*’ + • In the data instance declaration for ‘T1’ diff --git a/testsuite/tests/indexed-types/should_fail/SimpleFail2a.stderr b/testsuite/tests/indexed-types/should_fail/SimpleFail2a.stderr index a9262eb9ec..9bd571e2b9 100644 --- a/testsuite/tests/indexed-types/should_fail/SimpleFail2a.stderr +++ b/testsuite/tests/indexed-types/should_fail/SimpleFail2a.stderr @@ -2,6 +2,6 @@ SimpleFail2a.hs:11:3: error: • Type indexes must match class instance head Expected: Sd Int - Actual: Sd a + Actual: Sd a :: * • In the data instance declaration for ‘Sd’ In the instance declaration for ‘C Int’ diff --git a/testsuite/tests/indexed-types/should_fail/SimpleFail2b.stderr b/testsuite/tests/indexed-types/should_fail/SimpleFail2b.stderr index bb0aaca16c..88fdfe127c 100644 --- a/testsuite/tests/indexed-types/should_fail/SimpleFail2b.stderr +++ b/testsuite/tests/indexed-types/should_fail/SimpleFail2b.stderr @@ -1,5 +1,5 @@ -SimpleFail2b.hs:9:11: +SimpleFail2b.hs:9:11: error: Conflicting family instance declarations: - Sd Int = SdC1 Char -- Defined at SimpleFail2b.hs:9:11 - Sd Int = SdC2 Char -- Defined at SimpleFail2b.hs:10:11 + Sd Int -- Defined at SimpleFail2b.hs:9:11 + Sd Int -- Defined at SimpleFail2b.hs:10:11 diff --git a/testsuite/tests/indexed-types/should_fail/SimpleFail6.stderr b/testsuite/tests/indexed-types/should_fail/SimpleFail6.stderr index 6c04646b81..92d8db7912 100644 --- a/testsuite/tests/indexed-types/should_fail/SimpleFail6.stderr +++ b/testsuite/tests/indexed-types/should_fail/SimpleFail6.stderr @@ -1,5 +1,5 @@ -SimpleFail6.hs:6:10: error: +SimpleFail6.hs:7:11: error: Conflicting definitions for ‘a’ - Bound at: SimpleFail6.hs:6:10 + Bound at: SimpleFail6.hs:7:11 SimpleFail6.hs:7:13 diff --git a/testsuite/tests/indexed-types/should_fail/T10817.stderr b/testsuite/tests/indexed-types/should_fail/T10817.stderr index 32c0e7f223..715febdc25 100644 --- a/testsuite/tests/indexed-types/should_fail/T10817.stderr +++ b/testsuite/tests/indexed-types/should_fail/T10817.stderr @@ -1,6 +1,6 @@ T10817.hs:9:3: error: The type family application ‘F a’ - is no smaller than the instance head + is no smaller than the instance head ‘F a’ (Use UndecidableInstances to permit this) In the class declaration for ‘C’ diff --git a/testsuite/tests/indexed-types/should_fail/T12522a.hs b/testsuite/tests/indexed-types/should_fail/T12522a.hs index eb855f4171..e8b12c4d1e 100644 --- a/testsuite/tests/indexed-types/should_fail/T12522a.hs +++ b/testsuite/tests/indexed-types/should_fail/T12522a.hs @@ -5,13 +5,15 @@ module T12522a where +import Data.Kind (Type) + newtype I a = I a -type family Curry (as :: [*]) b = f | f -> as b where +type family Curry (as :: [Type]) b = f | f -> as b where Curry '[] b = I b Curry (a:as) b = a -> Curry as b -data Uncurried (as :: [*]) b +data Uncurried (as :: [Type]) b def :: Curry as b -> Uncurried as b def = undefined diff --git a/testsuite/tests/indexed-types/should_fail/T12522a.stderr b/testsuite/tests/indexed-types/should_fail/T12522a.stderr index 7356791a97..d3e3b66d72 100644 --- a/testsuite/tests/indexed-types/should_fail/T12522a.stderr +++ b/testsuite/tests/indexed-types/should_fail/T12522a.stderr @@ -1,17 +1,17 @@ -T12522a.hs:20:26: error: +T12522a.hs:22:26: error: • Ambiguous type variable ‘a0’ arising from a use of ‘show’ prevents the constraint ‘(Show a0)’ from being solved. Relevant bindings include - n :: a0 (bound at T12522a.hs:20:15) - test :: Uncurried '[a0, [Char]] [Char] (bound at T12522a.hs:20:1) + n :: a0 (bound at T12522a.hs:22:15) + test :: Uncurried '[a0, [Char]] [Char] (bound at T12522a.hs:22:1) Probable fix: use a type annotation to specify what ‘a0’ should be. These potential instances exist: instance Show Ordering -- Defined in ‘GHC.Show’ instance Show Integer -- Defined in ‘GHC.Show’ instance Show a => Show (Maybe a) -- Defined in ‘GHC.Show’ ...plus 22 others - ...plus five instances involving out-of-scope types + ...plus 12 instances involving out-of-scope types (use -fprint-potential-instances to see them all) • In the first argument of ‘(++)’, namely ‘show n’ In the second argument of ‘($)’, namely ‘show n ++ s’ diff --git a/testsuite/tests/indexed-types/should_fail/T12867.stderr b/testsuite/tests/indexed-types/should_fail/T12867.stderr index 40e566b3ec..2115e43541 100644 --- a/testsuite/tests/indexed-types/should_fail/T12867.stderr +++ b/testsuite/tests/indexed-types/should_fail/T12867.stderr @@ -1,7 +1,6 @@ T12867.hs:7:21: error: - • Expecting one fewer arguments to ‘TestM’ - Expected kind ‘k0 -> *’, but ‘TestM’ has kind ‘*’ + • Expected kind ‘k0 -> *’, but ‘TestM’ has kind ‘*’ • In the first argument of ‘Eq’, namely ‘(TestM a)’ In the type ‘(Eq (TestM a))’ In the type declaration for ‘Test2’ diff --git a/testsuite/tests/indexed-types/should_fail/T13674.hs b/testsuite/tests/indexed-types/should_fail/T13674.hs index 4d9a81d8a5..2951406241 100644 --- a/testsuite/tests/indexed-types/should_fail/T13674.hs +++ b/testsuite/tests/indexed-types/should_fail/T13674.hs @@ -11,11 +11,11 @@ module T13674 where import Data.Proxy -import GHC.Exts (Constraint) +import Data.Kind (Constraint, Type) import GHC.TypeLits import Unsafe.Coerce (unsafeCoerce) -data Dict :: Constraint -> * where +data Dict :: Constraint -> Type where Dict :: a => Dict a infixr 9 :- diff --git a/testsuite/tests/indexed-types/should_fail/T13784.hs b/testsuite/tests/indexed-types/should_fail/T13784.hs index 36c72b98af..48982769a2 100644 --- a/testsuite/tests/indexed-types/should_fail/T13784.hs +++ b/testsuite/tests/indexed-types/should_fail/T13784.hs @@ -4,9 +4,10 @@ module T13784 where +import Data.Kind (Type) import Data.Monoid ((<>)) -data Product :: [*] -> * where +data Product :: [Type] -> Type where (:*) :: a -> Product as -> Product (a : as) Unit :: Product '[] infixr 5 :* @@ -18,7 +19,7 @@ instance (Show a, Show (Product as)) => Show (Product (a : as)) where show (a :* as) = show a <> " :* " <> show as class Divideable a as where - type Divide a as :: [*] + type Divide a as :: [Type] divide :: Product as -> (a, Product (Divide a as)) instance Divideable a (a : as) where diff --git a/testsuite/tests/indexed-types/should_fail/T13784.stderr b/testsuite/tests/indexed-types/should_fail/T13784.stderr index 79007badb3..63edf0482f 100644 --- a/testsuite/tests/indexed-types/should_fail/T13784.stderr +++ b/testsuite/tests/indexed-types/should_fail/T13784.stderr @@ -1,44 +1,38 @@ -T13784.hs:28:28: error: - • Could not deduce: as1 ~ (a1 : Divide a1 as1) - from the context: (a : as) ~ (a1 : as1) - bound by a pattern with constructor: - :* :: forall a (as :: [*]). a -> Product as -> Product (a : as), - in an equation for ‘divide’ - at T13784.hs:28:13-19 - ‘as1’ is a rigid type variable bound by - a pattern with constructor: - :* :: forall a (as :: [*]). a -> Product as -> Product (a : as), - in an equation for ‘divide’ - at T13784.hs:28:13-19 +T13784.hs:29:28: error: + • Couldn't match type ‘as’ with ‘a : Divide a as’ + ‘as’ is a rigid type variable bound by + the instance declaration + at T13784.hs:25:10-30 Expected type: Product (Divide a (a : as)) Actual type: Product as1 • In the expression: as In the expression: (a, as) In an equation for ‘divide’: divide (a :* as) = (a, as) • Relevant bindings include - as :: Product as1 (bound at T13784.hs:28:18) - a :: a1 (bound at T13784.hs:28:13) + divide :: Product (a : as) -> (a, Product (Divide a (a : as))) + (bound at T13784.hs:29:5) -T13784.hs:32:24: error: - • Couldn't match type ‘Product (a1 : as0)’ - with ‘(b, Product (Divide b (a1 : as1)))’ +T13784.hs:33:24: error: + • Couldn't match type ‘Product (a : as0)’ + with ‘(b, Product (Divide b (a : as)))’ Expected type: (b, Product (Divide b (a : as))) Actual type: Product (a1 : as0) • In the expression: a :* divide as In an equation for ‘divide’: divide (a :* as) = a :* divide as In the instance declaration for ‘Divideable b (a : as)’ • Relevant bindings include - as :: Product as1 (bound at T13784.hs:32:18) - a :: a1 (bound at T13784.hs:32:13) divide :: Product (a : as) -> (b, Product (Divide b (a : as))) - (bound at T13784.hs:32:5) + (bound at T13784.hs:33:5) -T13784.hs:32:29: error: - • Couldn't match expected type ‘Product as0’ - with actual type ‘(a0, Product (Divide a0 as1))’ +T13784.hs:33:29: error: + • Couldn't match type ‘(a0, Product (Divide a0 as))’ + with ‘Product as0’ + Expected type: Product as0 + Actual type: (a0, Product (Divide a0 as1)) • In the second argument of ‘(:*)’, namely ‘divide as’ In the expression: a :* divide as In an equation for ‘divide’: divide (a :* as) = a :* divide as • Relevant bindings include - as :: Product as1 (bound at T13784.hs:32:18) + divide :: Product (a : as) -> (b, Product (Divide b (a : as))) + (bound at T13784.hs:33:5) diff --git a/testsuite/tests/indexed-types/should_fail/T13877.hs b/testsuite/tests/indexed-types/should_fail/T13877.hs new file mode 100644 index 0000000000..89c79a60e3 --- /dev/null +++ b/testsuite/tests/indexed-types/should_fail/T13877.hs @@ -0,0 +1,74 @@ +{-# LANGUAGE AllowAmbiguousTypes #-} +{-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE Trustworthy #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE DataKinds, PolyKinds #-} +{-# LANGUAGE TypeOperators #-} +module T13877 where + +import Data.Kind + +data family Sing (a :: k) +data instance Sing (z :: [a]) where + SNil :: Sing '[] + SCons :: Sing x -> Sing xs -> Sing (x:xs) + +data TyFun :: Type -> Type -> Type +type a ~> b = TyFun a b -> Type +infixr 0 ~> + +type family Apply (f :: k1 ~> k2) (x :: k1) :: k2 +type a @@ b = Apply a b +infixl 9 @@ + +data FunArrow = (:->) | (:~>) + +class FunType (arr :: FunArrow) where + type Fun (k1 :: Type) arr (k2 :: Type) :: Type + +class FunType arr => AppType (arr :: FunArrow) where + type App k1 arr k2 (f :: Fun k1 arr k2) (x :: k1) :: k2 + +type FunApp arr = (FunType arr, AppType arr) + +instance FunType (:->) where + type Fun k1 (:->) k2 = k1 -> k2 + +instance AppType (:->) where + type App k1 (:->) k2 (f :: k1 -> k2) x = f x + +instance FunType (:~>) where + type Fun k1 (:~>) k2 = k1 ~> k2 + +instance AppType (:~>) where + type App k1 (:~>) k2 (f :: k1 ~> k2) x = f @@ x + +infixr 0 -?> +type (-?>) (k1 :: Type) (k2 :: Type) (arr :: FunArrow) = Fun k1 arr k2 + +listElim :: forall (a :: Type) (p :: [a] -> Type) (l :: [a]). + Sing l + -> p '[] + -> (forall (x :: a) (xs :: [a]). Sing x -> Sing xs -> p xs -> p (x:xs)) + -> p l +listElim = listElimPoly @(:->) @a @p @l + +listElimTyFun :: forall (a :: Type) (p :: [a] ~> Type) (l :: [a]). + Sing l + -> p @@ '[] + -> (forall (x :: a) (xs :: [a]). Sing x -> Sing xs -> p @@ xs -> p @@ (x:xs)) + -> p @@ l +listElimTyFun = listElimPoly @(:->) @a @p @l + +listElimPoly :: forall (arr :: FunArrow) (a :: Type) (p :: ([a] -?> Type) arr) (l :: [a]). + FunApp arr + => Sing l + -> App [a] arr Type p '[] + -> (forall (x :: a) (xs :: [a]). Sing x -> Sing xs -> App [a] arr Type p xs -> App [a] arr Type p (x:xs)) + -> App [a] arr Type p l +listElimPoly SNil pNil _ = pNil +listElimPoly (SCons x (xs :: Sing xs)) pNil pCons = pCons x xs (listElimPoly @arr @a @p @xs xs pNil pCons) diff --git a/testsuite/tests/indexed-types/should_fail/T13877.stderr b/testsuite/tests/indexed-types/should_fail/T13877.stderr new file mode 100644 index 0000000000..9dc8534ca1 --- /dev/null +++ b/testsuite/tests/indexed-types/should_fail/T13877.stderr @@ -0,0 +1,33 @@ + +T13877.hs:65:17: error: + • Couldn't match type ‘Apply p (x : xs)’ with ‘p (x : xs)’ + Expected type: Sing x + -> Sing xs + -> App [a1] (':->) * p xs + -> App [a1] (':->) * p (x : xs) + Actual type: Sing x -> Sing xs -> (p @@ xs) -> p @@ (x : xs) + • In the expression: listElimPoly @(:->) @a @p @l + In an equation for ‘listElimTyFun’: + listElimTyFun = listElimPoly @(:->) @a @p @l + • Relevant bindings include + listElimTyFun :: Sing l + -> (p @@ '[]) + -> (forall (x :: a1) (xs :: [a1]). + Sing x -> Sing xs -> (p @@ xs) -> p @@ (x : xs)) + -> p @@ l + (bound at T13877.hs:65:1) + +T13877.hs:65:41: error: + • Expecting one more argument to ‘p’ + Expected kind ‘(-?>) [a1] * (':->)’, but ‘p’ has kind ‘[a1] ~> *’ + • In the type ‘p’ + In the expression: listElimPoly @(:->) @a @p @l + In an equation for ‘listElimTyFun’: + listElimTyFun = listElimPoly @(:->) @a @p @l + • Relevant bindings include + listElimTyFun :: Sing l + -> (p @@ '[]) + -> (forall (x :: a1) (xs :: [a1]). + Sing x -> Sing xs -> (p @@ xs) -> p @@ (x : xs)) + -> p @@ l + (bound at T13877.hs:65:1) diff --git a/testsuite/tests/indexed-types/should_fail/T13972.hs b/testsuite/tests/indexed-types/should_fail/T13972.hs new file mode 100644 index 0000000000..a0a203d30a --- /dev/null +++ b/testsuite/tests/indexed-types/should_fail/T13972.hs @@ -0,0 +1,12 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE TypeFamilies #-} +module Bug where + +import Data.Kind + +class C (a :: k) where + type T k :: Type + +instance C Left where + type T (a -> Either a b) = Int diff --git a/testsuite/tests/indexed-types/should_fail/T13972.stderr b/testsuite/tests/indexed-types/should_fail/T13972.stderr new file mode 100644 index 0000000000..b1f05b3105 --- /dev/null +++ b/testsuite/tests/indexed-types/should_fail/T13972.stderr @@ -0,0 +1,7 @@ + +T13972.hs:12:8: error: + • Type indexes must match class instance head + Expected: T (a1 -> Either a1 b1) + Actual: T (a -> Either a b) + • In the type instance declaration for ‘T’ + In the instance declaration for ‘C Left’ diff --git a/testsuite/tests/indexed-types/should_fail/T14033.hs b/testsuite/tests/indexed-types/should_fail/T14033.hs new file mode 100644 index 0000000000..2c8ab68a05 --- /dev/null +++ b/testsuite/tests/indexed-types/should_fail/T14033.hs @@ -0,0 +1,10 @@ +{-# LANGUAGE TypeFamilies #-} + +module T14033 where + +newtype Zero = Zero +newtype Succ a = Succ a + +type family Add n m :: * where + Add Zero m = m + Add (Succ n) m = Succ (Add n m) diff --git a/testsuite/tests/indexed-types/should_fail/T14033.stderr b/testsuite/tests/indexed-types/should_fail/T14033.stderr new file mode 100644 index 0000000000..fbc6b54486 --- /dev/null +++ b/testsuite/tests/indexed-types/should_fail/T14033.stderr @@ -0,0 +1,6 @@ + +T14033.hs:5:16: error: + • The constructor of a newtype must have exactly one field + but ‘Zero’ has none + • In the definition of data constructor ‘Zero’ + In the newtype declaration for ‘Zero’ diff --git a/testsuite/tests/indexed-types/should_fail/T14045a.hs b/testsuite/tests/indexed-types/should_fail/T14045a.hs new file mode 100644 index 0000000000..fc545a8d41 --- /dev/null +++ b/testsuite/tests/indexed-types/should_fail/T14045a.hs @@ -0,0 +1,13 @@ +{-# LANGUAGE TypeFamilies, PolyKinds, DataKinds, GADTs, FlexibleInstances #-} + +module T14045a where + +import Data.Kind + +class C (a :: k) where + data S (a :: k) + +instance C (z :: Bool) where + data S :: Bool -> Type where + SF :: S False + ST :: S True diff --git a/testsuite/tests/indexed-types/should_fail/T14045a.stderr b/testsuite/tests/indexed-types/should_fail/T14045a.stderr new file mode 100644 index 0000000000..0306bd2a07 --- /dev/null +++ b/testsuite/tests/indexed-types/should_fail/T14045a.stderr @@ -0,0 +1,7 @@ + +T14045a.hs:11:3: error: + • Type indexes must match class instance head + Expected: S z + Actual: S :: Bool -> Type + • In the data instance declaration for ‘S’ + In the instance declaration for ‘C (z :: Bool)’ diff --git a/testsuite/tests/indexed-types/should_fail/T14175.hs b/testsuite/tests/indexed-types/should_fail/T14175.hs new file mode 100644 index 0000000000..2e84b730e1 --- /dev/null +++ b/testsuite/tests/indexed-types/should_fail/T14175.hs @@ -0,0 +1,7 @@ +{-# LANGUAGE TypeFamilies, DataKinds, PolyKinds #-} + +module T14175 where + +import Data.Kind + +type family PComp (k :: j -> Type) (x :: k) :: () diff --git a/testsuite/tests/indexed-types/should_fail/T14175.stderr b/testsuite/tests/indexed-types/should_fail/T14175.stderr new file mode 100644 index 0000000000..dbadbe1f46 --- /dev/null +++ b/testsuite/tests/indexed-types/should_fail/T14175.stderr @@ -0,0 +1,5 @@ + +T14175.hs:7:42: error: + • Expecting one more argument to ‘k’ + Expected a type, but ‘k’ has kind ‘j -> *’ + • In the kind ‘k’ diff --git a/testsuite/tests/indexed-types/should_fail/T14179.hs b/testsuite/tests/indexed-types/should_fail/T14179.hs new file mode 100644 index 0000000000..60c8a94c39 --- /dev/null +++ b/testsuite/tests/indexed-types/should_fail/T14179.hs @@ -0,0 +1,20 @@ +{-# LANGUAGE GADTs #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE TypeFamilies #-} +module T14179 where + +data family Foo1 a +data instance Foo1 a +data instance Foo1 a + +data family Foo2 :: k -> * +data instance Foo2 :: * -> * +data instance Foo2 :: * -> * + +data family Foo3 a +data instance Foo3 [a] where + Foo3a :: Foo3 [Int] + Foo3b :: Foo3 [Bool] +data instance Foo3 [a] where + Foo3c :: Foo3 [a] + Foo3d :: Foo3 [Char] diff --git a/testsuite/tests/indexed-types/should_fail/T14179.stderr b/testsuite/tests/indexed-types/should_fail/T14179.stderr new file mode 100644 index 0000000000..38d77f1cca --- /dev/null +++ b/testsuite/tests/indexed-types/should_fail/T14179.stderr @@ -0,0 +1,15 @@ + +T14179.hs:7:15: error: + Conflicting family instance declarations: + Foo1 a -- Defined at T14179.hs:7:15 + Foo1 a -- Defined at T14179.hs:8:15 + +T14179.hs:11:15: error: + Conflicting family instance declarations: + Foo2 a -- Defined at T14179.hs:11:15 + Foo2 a -- Defined at T14179.hs:12:15 + +T14179.hs:15:15: error: + Conflicting family instance declarations: + Foo3 [a] -- Defined at T14179.hs:15:15 + Foo3 [a] -- Defined at T14179.hs:18:15 diff --git a/testsuite/tests/indexed-types/should_fail/T14246.hs b/testsuite/tests/indexed-types/should_fail/T14246.hs new file mode 100644 index 0000000000..6ae8760c84 --- /dev/null +++ b/testsuite/tests/indexed-types/should_fail/T14246.hs @@ -0,0 +1,23 @@ +{-# LANGUAGE RankNTypes, GADTs, TypeOperators, PolyKinds, DataKinds, TypeFamilies, AllowAmbiguousTypes, UndecidableInstances, TypeInType #-} + +module T14246 where + +import Data.Kind + +data Nat = Z | S Nat + +data Vect :: Nat -> Type -> Type where + Nil :: Vect Z a + Cons :: a -> Vect n a -> Vect (S n) a + +data Label a = Label a + +data L + +type family KLN (n :: k) :: Nat where + KLN (f :: v -> k) = S (KLN (forall t. f t)) + KLN (f :: Type) = Z + +type family Reveal (n :: k) (l :: Vect (KLN n) L) :: Type where + Reveal (f :: v -> k) (Cons (Label (t :: v)) l) = Reveal (f t) l + Reveal (a :: Type) Nil = a diff --git a/testsuite/tests/indexed-types/should_fail/T14246.stderr b/testsuite/tests/indexed-types/should_fail/T14246.stderr new file mode 100644 index 0000000000..4bb45d6399 --- /dev/null +++ b/testsuite/tests/indexed-types/should_fail/T14246.stderr @@ -0,0 +1,24 @@ + +T14246.hs:18:5: error: + • Illegal polymorphic type: forall (t :: v). f t + • In the equations for closed type family ‘KLN’ + In the type family declaration for ‘KLN’ + +T14246.hs:22:27: error: + • Expected kind ‘Vect (KLN f) L’, + but ‘Cons (Label (t :: v)) l’ has kind ‘Vect ('S (KLN (f t))) *’ + • In the second argument of ‘Reveal’, namely + ‘(Cons (Label (t :: v)) l)’ + In the type family declaration for ‘Reveal’ + +T14246.hs:22:67: error: + • Expected kind ‘Vect (KLN (f t)) L’, + but ‘l’ has kind ‘Vect (KLN (f t)) *’ + • In the second argument of ‘Reveal’, namely ‘l’ + In the type ‘Reveal (f t) l’ + In the type family declaration for ‘Reveal’ + +T14246.hs:23:24: error: + • Expected kind ‘Vect (KLN a) L’, but ‘Nil’ has kind ‘Vect 'Z L’ + • In the second argument of ‘Reveal’, namely ‘Nil’ + In the type family declaration for ‘Reveal’ diff --git a/testsuite/tests/indexed-types/should_fail/T14369.hs b/testsuite/tests/indexed-types/should_fail/T14369.hs new file mode 100644 index 0000000000..ef5166c318 --- /dev/null +++ b/testsuite/tests/indexed-types/should_fail/T14369.hs @@ -0,0 +1,27 @@ +{-# LANGUAGE AllowAmbiguousTypes #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeFamilyDependencies #-} +{-# LANGUAGE DataKinds, PolyKinds #-} +{-# LANGUAGE TypeOperators #-} +module T14369 where + +data family Sing (a :: k) + +data instance Sing (z :: Maybe a) where + SNothing :: Sing Nothing + SJust :: Sing x -> Sing (Just x) + +class SingKind k where + type Demote k = r | r -> k + fromSing :: Sing (a :: k) -> Demote k + +instance SingKind a => SingKind (Maybe a) where + type Demote (Maybe a) = Maybe (Demote a) + fromSing SNothing = Nothing + fromSing (SJust x) = Just (fromSing x) + +f :: forall (x :: forall a. Maybe a) a. SingKind a => Sing x -> Maybe (Demote a) +f = fromSing diff --git a/testsuite/tests/indexed-types/should_fail/T14369.stderr b/testsuite/tests/indexed-types/should_fail/T14369.stderr new file mode 100644 index 0000000000..96e55d2f1e --- /dev/null +++ b/testsuite/tests/indexed-types/should_fail/T14369.stderr @@ -0,0 +1,9 @@ + +T14369.hs:27:5: error: + • Couldn't match type ‘Demote a’ with ‘Demote a1’ + Expected type: Sing x -> Maybe (Demote a1) + Actual type: Sing x -> Demote (Maybe a) + • In the expression: fromSing + In an equation for ‘f’: f = fromSing + • Relevant bindings include + f :: Sing x -> Maybe (Demote a1) (bound at T14369.hs:27:1) diff --git a/testsuite/tests/indexed-types/should_fail/T14904.hs b/testsuite/tests/indexed-types/should_fail/T14904.hs new file mode 100644 index 0000000000..db7f1f4d0e --- /dev/null +++ b/testsuite/tests/indexed-types/should_fail/T14904.hs @@ -0,0 +1,8 @@ +{-# LANGUAGE TypeInType, TypeFamilies, RankNTypes #-}
+
+module T14904 where
+
+import Data.Kind
+
+type family F f :: Type where
+ F ((f :: forall a. g a) :: forall a. g a) = Int
diff --git a/testsuite/tests/indexed-types/should_fail/T14904.stderr b/testsuite/tests/indexed-types/should_fail/T14904.stderr new file mode 100644 index 0000000000..dd5506c855 --- /dev/null +++ b/testsuite/tests/indexed-types/should_fail/T14904.stderr @@ -0,0 +1,6 @@ + +T14904.hs:8:8: error: + • Expected kind ‘forall (a :: k1). g a’, but ‘f’ has kind ‘k0’ + • In the first argument of ‘F’, namely + ‘((f :: forall a. g a) :: forall a. g a)’ + In the type family declaration for ‘F’ diff --git a/testsuite/tests/indexed-types/should_fail/T15172.hs b/testsuite/tests/indexed-types/should_fail/T15172.hs new file mode 100644 index 0000000000..da7a8f80f2 --- /dev/null +++ b/testsuite/tests/indexed-types/should_fail/T15172.hs @@ -0,0 +1,11 @@ +{-# LANGUAGE TypeFamilies, ConstraintKinds, FlexibleInstances #-} +module ShouldFail where + +import GHC.Exts( Constraint ) + +type family F a :: Constraint + +class C a where + +-- Should be rejected because of the type family +instance (F a) => C [[a]] where diff --git a/testsuite/tests/indexed-types/should_fail/T15172.stderr b/testsuite/tests/indexed-types/should_fail/T15172.stderr new file mode 100644 index 0000000000..8c28c5148c --- /dev/null +++ b/testsuite/tests/indexed-types/should_fail/T15172.stderr @@ -0,0 +1,5 @@ + +T15172.hs:11:10: error: + • Illegal nested constraint ‘F a’ + (Use UndecidableInstances to permit this) + • In the instance declaration for ‘C [[a]]’ diff --git a/testsuite/tests/indexed-types/should_fail/T1897b.stderr b/testsuite/tests/indexed-types/should_fail/T1897b.stderr index d3c8b06451..59109982ea 100644 --- a/testsuite/tests/indexed-types/should_fail/T1897b.stderr +++ b/testsuite/tests/indexed-types/should_fail/T1897b.stderr @@ -3,11 +3,11 @@ T1897b.hs:16:1: error: • Couldn't match type ‘Depend a’ with ‘Depend a0’ Expected type: t (Depend a) -> Bool Actual type: t (Depend a0) -> Bool - NB: ‘Depend’ is a type function, and may not be injective + NB: ‘Depend’ is a non-injective type family The type variable ‘a0’ is ambiguous • In the ambiguity check for the inferred type for ‘isValid’ To defer the ambiguity check to use sites, enable AllowAmbiguousTypes When checking the inferred type isValid :: forall (t :: * -> *) a. - (Bug a, Foldable t) => + (Foldable t, Bug a) => t (Depend a) -> Bool diff --git a/testsuite/tests/indexed-types/should_fail/T1900.stderr b/testsuite/tests/indexed-types/should_fail/T1900.stderr index 0783a2dba7..4b144f85f6 100644 --- a/testsuite/tests/indexed-types/should_fail/T1900.stderr +++ b/testsuite/tests/indexed-types/should_fail/T1900.stderr @@ -3,7 +3,7 @@ T1900.hs:7:3: error: • Couldn't match type ‘Depend s0’ with ‘Depend s’ Expected type: Depend s -> Depend s Actual type: Depend s0 -> Depend s0 - NB: ‘Depend’ is a type function, and may not be injective + NB: ‘Depend’ is a non-injective type family The type variable ‘s0’ is ambiguous • In the ambiguity check for ‘trans’ To defer the ambiguity check to use sites, enable AllowAmbiguousTypes diff --git a/testsuite/tests/indexed-types/should_fail/T2203a.stderr b/testsuite/tests/indexed-types/should_fail/T2203a.stderr index f6e7f31d3c..80c65504f3 100644 --- a/testsuite/tests/indexed-types/should_fail/T2203a.stderr +++ b/testsuite/tests/indexed-types/should_fail/T2203a.stderr @@ -1,5 +1,5 @@ -T2203a.hs:13:19: - Illegal type synonym family application in instance: - Either a (TheFoo a) - In the instance declaration for ‘Bar (Either a (TheFoo a))’ +T2203a.hs:13:19: error: + • Illegal type synonym family application ‘TheFoo a’ in instance: + Bar (Either a (TheFoo a)) + • In the instance declaration for ‘Bar (Either a (TheFoo a))’ diff --git a/testsuite/tests/indexed-types/should_fail/T2334A.stderr b/testsuite/tests/indexed-types/should_fail/T2334A.stderr index 7b7d265d61..a5bc0a0e78 100644 --- a/testsuite/tests/indexed-types/should_fail/T2334A.stderr +++ b/testsuite/tests/indexed-types/should_fail/T2334A.stderr @@ -1,17 +1,17 @@ -T2334A.hs:9:26: - The constructor of a newtype must have exactly one field - but ‘F’ has two - In the definition of data constructor ‘F’ - In the newtype instance declaration for ‘F’ +T2334A.hs:9:26: error: + • The constructor of a newtype must have exactly one field + but ‘F’ has two + • In the definition of data constructor ‘F’ + In the newtype instance declaration for ‘F’ -T2334A.hs:10:27: - The constructor of a newtype must have exactly one field - but ‘H’ has none - In the definition of data constructor ‘H’ - In the newtype instance declaration for ‘F’ +T2334A.hs:10:27: error: + • The constructor of a newtype must have exactly one field + but ‘H’ has none + • In the definition of data constructor ‘H’ + In the newtype instance declaration for ‘F’ -T2334A.hs:12:15: +T2334A.hs:12:15: error: Conflicting family instance declarations: - F Bool = K1 -- Defined at T2334A.hs:12:15 - F Bool = K2 -- Defined at T2334A.hs:13:15 + F Bool -- Defined at T2334A.hs:12:15 + F Bool -- Defined at T2334A.hs:13:15 diff --git a/testsuite/tests/indexed-types/should_fail/T2544.hs b/testsuite/tests/indexed-types/should_fail/T2544.hs index 2150cd5775..34a79f4db8 100644 --- a/testsuite/tests/indexed-types/should_fail/T2544.hs +++ b/testsuite/tests/indexed-types/should_fail/T2544.hs @@ -4,10 +4,12 @@ module T2544 where +import Data.Kind + data (:|:) a b = Inl a | Inr b class Ix i where - type IxMap i :: * -> * + type IxMap i :: Type -> Type empty :: IxMap i [Int] data BiApp a b c = BiApp (a c) (b c) diff --git a/testsuite/tests/indexed-types/should_fail/T2544.stderr b/testsuite/tests/indexed-types/should_fail/T2544.stderr index b943db2087..93d7746066 100644 --- a/testsuite/tests/indexed-types/should_fail/T2544.stderr +++ b/testsuite/tests/indexed-types/should_fail/T2544.stderr @@ -1,24 +1,24 @@ -T2544.hs:17:12: error: +T2544.hs:19:12: error: • Couldn't match type ‘IxMap r’ with ‘IxMap i1’ Expected type: IxMap (l :|: r) [Int] Actual type: BiApp (IxMap l) (IxMap i1) [Int] - NB: ‘IxMap’ is a type function, and may not be injective + NB: ‘IxMap’ is a non-injective type family The type variable ‘i1’ is ambiguous • In the expression: BiApp empty empty In an equation for ‘empty’: empty = BiApp empty empty In the instance declaration for ‘Ix (l :|: r)’ • Relevant bindings include - empty :: IxMap (l :|: r) [Int] (bound at T2544.hs:17:4) + empty :: IxMap (l :|: r) [Int] (bound at T2544.hs:19:4) -T2544.hs:17:18: error: +T2544.hs:19:18: error: • Couldn't match type ‘IxMap i0’ with ‘IxMap l’ Expected type: IxMap l [Int] Actual type: IxMap i0 [Int] - NB: ‘IxMap’ is a type function, and may not be injective + NB: ‘IxMap’ is a non-injective type family The type variable ‘i0’ is ambiguous • In the first argument of ‘BiApp’, namely ‘empty’ In the expression: BiApp empty empty In an equation for ‘empty’: empty = BiApp empty empty • Relevant bindings include - empty :: IxMap (l :|: r) [Int] (bound at T2544.hs:17:4) + empty :: IxMap (l :|: r) [Int] (bound at T2544.hs:19:4) diff --git a/testsuite/tests/indexed-types/should_fail/T2664.stderr b/testsuite/tests/indexed-types/should_fail/T2664.stderr index 21fbb64e3c..f52703865f 100644 --- a/testsuite/tests/indexed-types/should_fail/T2664.stderr +++ b/testsuite/tests/indexed-types/should_fail/T2664.stderr @@ -9,7 +9,7 @@ T2664.hs:31:9: error: at T2664.hs:23:5-12 Expected type: IO (PChan (a :*: b), PChan c) Actual type: IO (PChan (a :*: b), PChan (Dual b :+: Dual a)) - NB: ‘Dual’ is a type function, and may not be injective + NB: ‘Dual’ is a non-injective type family • In a stmt of a 'do' block: return (O $ takeMVar v, diff --git a/testsuite/tests/indexed-types/should_fail/T3330c.hs b/testsuite/tests/indexed-types/should_fail/T3330c.hs index e6c4dfbb30..d84c51d5d5 100644 --- a/testsuite/tests/indexed-types/should_fail/T3330c.hs +++ b/testsuite/tests/indexed-types/should_fail/T3330c.hs @@ -2,9 +2,11 @@ module T3330c where +import Data.Kind + data (f :+: g) x = Inl (f x) | Inr (g x) -data R :: (* -> *) -> * where +data R :: (Type -> Type) -> Type where RSum :: R f -> R g -> R (f :+: g) class Rep f where @@ -13,7 +15,7 @@ class Rep f where instance (Rep f, Rep g) => Rep (f :+: g) where rep = RSum rep rep -type family Der (f :: * -> *) :: * -> * +type family Der (f :: Type -> Type) :: Type -> Type type instance Der (f :+: g) = Der f :+: Der g plug :: Rep f => Der f x -> x -> f x @@ -55,4 +57,4 @@ Hence f1 ~ f1 x --}
\ No newline at end of file +-} diff --git a/testsuite/tests/indexed-types/should_fail/T3330c.stderr b/testsuite/tests/indexed-types/should_fail/T3330c.stderr index 829bca1400..4ef5ae66a8 100644 --- a/testsuite/tests/indexed-types/should_fail/T3330c.stderr +++ b/testsuite/tests/indexed-types/should_fail/T3330c.stderr @@ -1,5 +1,5 @@ -T3330c.hs:23:43: error: +T3330c.hs:25:43: error: • Couldn't match kind ‘* -> *’ with ‘*’ When matching types f1 :: * -> * @@ -10,7 +10,7 @@ T3330c.hs:23:43: error: In the first argument of ‘Inl’, namely ‘(plug rf df x)’ In the expression: Inl (plug rf df x) • Relevant bindings include - x :: x (bound at T3330c.hs:23:29) - df :: f1 x (bound at T3330c.hs:23:25) - rf :: R f1 (bound at T3330c.hs:23:13) - plug' :: R f -> Der f x -> x -> f x (bound at T3330c.hs:23:1) + x :: x (bound at T3330c.hs:25:29) + df :: f1 x (bound at T3330c.hs:25:25) + rf :: R f1 (bound at T3330c.hs:25:13) + plug' :: R f -> Der f x -> x -> f x (bound at T3330c.hs:25:1) diff --git a/testsuite/tests/indexed-types/should_fail/T4099.stderr b/testsuite/tests/indexed-types/should_fail/T4099.stderr index a0ddc964ff..acc2ed29ae 100644 --- a/testsuite/tests/indexed-types/should_fail/T4099.stderr +++ b/testsuite/tests/indexed-types/should_fail/T4099.stderr @@ -1,7 +1,7 @@ T4099.hs:11:30: error: • Couldn't match expected type ‘T a0’ with actual type ‘T b’ - NB: ‘T’ is a type function, and may not be injective + NB: ‘T’ is a non-injective type family The type variable ‘a0’ is ambiguous • In the second argument of ‘foo’, namely ‘x’ In the expression: foo (error "urk") x diff --git a/testsuite/tests/indexed-types/should_fail/T4174.hs b/testsuite/tests/indexed-types/should_fail/T4174.hs index 784c0baa08..a4f105ff86 100644 --- a/testsuite/tests/indexed-types/should_fail/T4174.hs +++ b/testsuite/tests/indexed-types/should_fail/T4174.hs @@ -2,6 +2,8 @@ module T4174 where +import Data.Kind (Type) + data True data False @@ -10,17 +12,17 @@ data Minor1 data GHC6'8 m data GHC6'10 m -type family a :<=: b :: {-Bool-}* +type family a :<=: b :: {-Bool-} Type type instance GHC6'10 m1 :<=: GHC6'8 m2 = False type a :>=: b = b :<=: a data Way ghcVersion tablesNextToCode profiling threaded -type family GHCVersion way :: {-GHCVersion-} * +type family GHCVersion way :: {-GHCVersion-} Type type instance GHCVersion (Way v n p t) = v -type family Threaded way :: {-Bool-} * +type family Threaded way :: {-Bool-} Type type instance Threaded (Way v n p t) = t data Field w s t @@ -30,7 +32,7 @@ data RtsSpinLock field :: String -> m (Field w a b) field = undefined -type family WayOf (m :: * -> *) :: * +type family WayOf (m :: Type -> Type) :: Type sync_large_objects :: (Monad m, (GHCVersion (WayOf m) :>=: GHC6'10 Minor1) ~ True, @@ -57,4 +59,4 @@ testcase = sync_large_objects == (GHC6'10 Minor1 :<=: GHC6'8 minor) ~ True == False ~ True --}
\ No newline at end of file +-} diff --git a/testsuite/tests/indexed-types/should_fail/T4174.stderr b/testsuite/tests/indexed-types/should_fail/T4174.stderr index db5008dd1e..ccc88ced1e 100644 --- a/testsuite/tests/indexed-types/should_fail/T4174.stderr +++ b/testsuite/tests/indexed-types/should_fail/T4174.stderr @@ -1,16 +1,16 @@ -T4174.hs:42:12: error: +T4174.hs:44:12: error: • Couldn't match type ‘b’ with ‘RtsSpinLock’ ‘b’ is a rigid type variable bound by the type signature for: testcase :: forall (m :: * -> *) minor n t p a b. Monad m => m (Field (Way (GHC6'8 minor) n t p) a b) - at T4174.hs:41:1-63 + at T4174.hs:43:1-63 Expected type: m (Field (Way (GHC6'8 minor) n t p) a b) Actual type: m (Field (WayOf m) SmStep RtsSpinLock) • In the expression: sync_large_objects In an equation for ‘testcase’: testcase = sync_large_objects • Relevant bindings include testcase :: m (Field (Way (GHC6'8 minor) n t p) a b) - (bound at T4174.hs:42:1) + (bound at T4174.hs:44:1) diff --git a/testsuite/tests/indexed-types/should_fail/T4179.stderr b/testsuite/tests/indexed-types/should_fail/T4179.stderr index 516bdf3802..2f0d5e3644 100644 --- a/testsuite/tests/indexed-types/should_fail/T4179.stderr +++ b/testsuite/tests/indexed-types/should_fail/T4179.stderr @@ -7,7 +7,7 @@ T4179.hs:26:16: error: Actual type: x (A2 (FCon x) -> A3 (FCon x)) -> A2 (x (A2 (FCon x) -> A3 (FCon x))) -> A3 (x (A2 (FCon x) -> A3 (FCon x))) - NB: ‘A2’ is a type function, and may not be injective + NB: ‘A2’ is a non-injective type family • In the first argument of ‘foldDoC’, namely ‘op’ In the expression: foldDoC op In an equation for ‘fCon’: fCon = foldDoC op diff --git a/testsuite/tests/indexed-types/should_fail/T5515.stderr b/testsuite/tests/indexed-types/should_fail/T5515.stderr index 25fbe9f0f0..688eef697e 100644 --- a/testsuite/tests/indexed-types/should_fail/T5515.stderr +++ b/testsuite/tests/indexed-types/should_fail/T5515.stderr @@ -1,8 +1,8 @@ -T5515.hs:9:3: - The RHS of an associated type declaration mentions ‘a’ +T5515.hs:9:3: error: + The RHS of an associated type declaration mentions out-of-scope variable ‘a’ All such variables must be bound on the LHS -T5515.hs:15:3: - The RHS of an associated type declaration mentions ‘a’ +T5515.hs:15:3: error: + The RHS of an associated type declaration mentions out-of-scope variable ‘a’ All such variables must be bound on the LHS diff --git a/testsuite/tests/indexed-types/should_fail/T5934.stderr b/testsuite/tests/indexed-types/should_fail/T5934.stderr index e303e54f74..21af0d868a 100644 --- a/testsuite/tests/indexed-types/should_fail/T5934.stderr +++ b/testsuite/tests/indexed-types/should_fail/T5934.stderr @@ -5,16 +5,3 @@ T5934.hs:12:7: error: GHC doesn't yet support impredicative polymorphism • In the expression: 0 In an equation for ‘run’: run = 0 - -T5934.hs:12:7: error: - • Ambiguous type variable ‘a0’ arising from the literal ‘0’ - prevents the constraint ‘(Num a0)’ from being solved. - Probable fix: use a type annotation to specify what ‘a0’ should be. - These potential instances exist: - instance Num Integer -- Defined in ‘GHC.Num’ - instance Num Double -- Defined in ‘GHC.Float’ - instance Num Float -- Defined in ‘GHC.Float’ - ...plus two others - (use -fprint-potential-instances to see them all) - • In the expression: 0 - In an equation for ‘run’: run = 0 diff --git a/testsuite/tests/indexed-types/should_fail/T7786.stderr b/testsuite/tests/indexed-types/should_fail/T7786.stderr deleted file mode 100644 index 89984ca6b0..0000000000 --- a/testsuite/tests/indexed-types/should_fail/T7786.stderr +++ /dev/null @@ -1,49 +0,0 @@ - -T7786.hs:94:41: error: - • Couldn't match type ‘xxx’ - with ‘Intersect (BuriedUnder sub k 'Empty) inv’ - Expected type: Maybe (Sing xxx) - Actual type: Maybe - (Sing (Intersect (BuriedUnder sub k 'Empty) inv)) - • In a stmt of a 'do' block: Nil :: Sing xxx <- foogle db k sub - In the expression: - do Nil :: Sing xxx <- foogle db k sub - return $ Sub db k sub - In an equation for ‘addSub’: - addSub db k sub - = do Nil :: Sing xxx <- foogle db k sub - return $ Sub db k sub - • Relevant bindings include - sub :: Database sub (bound at T7786.hs:94:13) - k :: Sing k (bound at T7786.hs:94:11) - db :: Database inv (bound at T7786.hs:94:8) - addSub :: Database inv - -> Sing k - -> Database sub - -> Maybe (Database (BuriedUnder sub k inv)) - (bound at T7786.hs:94:1) - -T7786.hs:95:31: error: - • Could not deduce: Intersect (BuriedUnder sub k 'Empty) inv - ~ - 'Empty - arising from a use of ‘Sub’ - from the context: xxx ~ 'Empty - bound by a pattern with constructor: Nil :: forall a. Sing 'Empty, - in a pattern binding in - 'do' block - at T7786.hs:94:22-24 - • In the second argument of ‘($)’, namely ‘Sub db k sub’ - In a stmt of a 'do' block: return $ Sub db k sub - In the expression: - do Nil :: Sing xxx <- foogle db k sub - return $ Sub db k sub - • Relevant bindings include - sub :: Database sub (bound at T7786.hs:94:13) - k :: Sing k (bound at T7786.hs:94:11) - db :: Database inv (bound at T7786.hs:94:8) - addSub :: Database inv - -> Sing k - -> Database sub - -> Maybe (Database (BuriedUnder sub k inv)) - (bound at T7786.hs:94:1) diff --git a/testsuite/tests/indexed-types/should_fail/T7938.stderr b/testsuite/tests/indexed-types/should_fail/T7938.stderr index a9b5aef499..d0c199b804 100644 --- a/testsuite/tests/indexed-types/should_fail/T7938.stderr +++ b/testsuite/tests/indexed-types/should_fail/T7938.stderr @@ -1,4 +1,6 @@ -T7938.hs:12:3: - The RHS of an associated type declaration mentions ‘k2’ - All such variables must be bound on the LHS +T7938.hs:12:16: error: + • Expected a type, but ‘(KP :: KProxy k2)’ has kind ‘KProxy k4’ + • In the type ‘(KP :: KProxy k2)’ + In the type instance declaration for ‘Bar’ + In the instance declaration for ‘Foo (a :: k1) (b :: k2)’ diff --git a/testsuite/tests/indexed-types/should_fail/T7967.hs b/testsuite/tests/indexed-types/should_fail/T7967.hs index 093f133563..ba828d60d0 100644 --- a/testsuite/tests/indexed-types/should_fail/T7967.hs +++ b/testsuite/tests/indexed-types/should_fail/T7967.hs @@ -1,21 +1,23 @@ {-# LANGUAGE TypeFamilies, DataKinds, TypeOperators, GADTs #-} module T7967 where +import Data.Kind (Type) + data Nat = Zero | Succ Nat -data SNat :: Nat -> * where +data SNat :: Nat -> Type where SZero :: SNat Zero SSucc :: SNat n -> SNat (Succ n) -data HList :: [*] -> * where +data HList :: [Type] -> Type where HNil :: HList '[] HCons :: h -> HList t -> HList (h ': t) -data Index :: Nat -> [*] -> * where +data Index :: Nat -> [Type] -> Type where IZero :: Index Zero (h ': t) ISucc :: Index n l -> Index (Succ n) (h ': l) -type family Lookup (n :: Nat) (l :: [*]) :: * +type family Lookup (n :: Nat) (l :: [Type]) :: Type type instance Lookup Zero (h ': t) = h type instance Lookup (Succ n) (h ': t) = Lookup n t diff --git a/testsuite/tests/indexed-types/should_fail/T7967.stderr b/testsuite/tests/indexed-types/should_fail/T7967.stderr index 44fb064594..63d2ba8328 100644 --- a/testsuite/tests/indexed-types/should_fail/T7967.stderr +++ b/testsuite/tests/indexed-types/should_fail/T7967.stderr @@ -1,7 +1,7 @@ -T7967.hs:31:26: - Couldn't match type ‘h0 : t0’ with ‘'[]’ - Expected type: Index n l - Actual type: Index 'Zero (h0 : t0) - In the expression: IZero - In an equation for ‘sNatToIndex’: sNatToIndex SZero HNil = IZero +T7967.hs:33:26: error: + • Couldn't match type ‘h0 : t0’ with ‘'[]’ + Expected type: Index n l + Actual type: Index 'Zero (h0 : t0) + • In the expression: IZero + In an equation for ‘sNatToIndex’: sNatToIndex SZero HNil = IZero diff --git a/testsuite/tests/indexed-types/should_fail/T8129.stdout b/testsuite/tests/indexed-types/should_fail/T8129.stdout index f2bab63c9e..b23febd728 100644 --- a/testsuite/tests/indexed-types/should_fail/T8129.stdout +++ b/testsuite/tests/indexed-types/should_fail/T8129.stdout @@ -1,3 +1,2 @@ • Could not deduce (C x0 (F x0)) • Could not deduce (C x0 (F x0)) - • Could not deduce (C x0 (F x0)) diff --git a/testsuite/tests/indexed-types/should_fail/T8518.hs b/testsuite/tests/indexed-types/should_fail/T8518.hs index 52d5440aa2..666ddd09ad 100644 --- a/testsuite/tests/indexed-types/should_fail/T8518.hs +++ b/testsuite/tests/indexed-types/should_fail/T8518.hs @@ -14,4 +14,4 @@ callCont :: Continuation c => c -> (Z c) -> (B c) -> Maybe (F c) callCont c z b = rpt (4 :: Int) c z b where rpt 0 c' z' b' = fromJust (fst <$> (continue c' z' b')) - rpt i c' z' b' = let c'' = fromJust (snd <$> (continue c' z' b')) in rpt (i-1) c''
\ No newline at end of file + rpt i c' z' b' = let c'' = fromJust (snd <$> (continue c' z' b')) in rpt (i-1) c'' diff --git a/testsuite/tests/indexed-types/should_fail/T9036.hs b/testsuite/tests/indexed-types/should_fail/T9036.hs index 550adb4b0a..54af6f6714 100644 --- a/testsuite/tests/indexed-types/should_fail/T9036.hs +++ b/testsuite/tests/indexed-types/should_fail/T9036.hs @@ -2,14 +2,15 @@ {-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeFamilies #-} - module T9036 where +import Data.Kind + class UncurryM t where - type GetMonad t :: * -> * + type GetMonad t :: Type -> Type class Curry a b where - type Curried a b :: * + type Curried a b :: Type gSimple :: String -> String -> [String] gSimple = simpleLogger (return ()) diff --git a/testsuite/tests/indexed-types/should_fail/T9036.stderr b/testsuite/tests/indexed-types/should_fail/T9036.stderr index cb12dea5b5..151dfb7f2d 100644 --- a/testsuite/tests/indexed-types/should_fail/T9036.stderr +++ b/testsuite/tests/indexed-types/should_fail/T9036.stderr @@ -1,9 +1,9 @@ -T9036.hs:17:17: error: +T9036.hs:18:17: error: • Couldn't match type ‘Curried t0 [t0]’ with ‘Curried t [t]’ Expected type: Maybe (GetMonad t after) -> Curried t [t] Actual type: Maybe (GetMonad t0 after) -> Curried t0 [t0] - NB: ‘Curried’ is a type function, and may not be injective + NB: ‘Curried’ is a non-injective type family The type variable ‘t0’ is ambiguous • In the ambiguity check for ‘simpleLogger’ To defer the ambiguity check to use sites, enable AllowAmbiguousTypes diff --git a/testsuite/tests/indexed-types/should_fail/T9097.stderr b/testsuite/tests/indexed-types/should_fail/T9097.stderr index 02dfc33068..32c987f70d 100644 --- a/testsuite/tests/indexed-types/should_fail/T9097.stderr +++ b/testsuite/tests/indexed-types/should_fail/T9097.stderr @@ -1,5 +1,6 @@ -T9097.hs:10:3: - Illegal type synonym family application in instance: Any - In the equations for closed type family ‘Foo’ - In the type family declaration for ‘Foo’ +T9097.hs:10:3: error: + • Illegal type synonym family application ‘Any’ in instance: + Foo Any + • In the equations for closed type family ‘Foo’ + In the type family declaration for ‘Foo’ diff --git a/testsuite/tests/indexed-types/should_fail/T9171.stderr b/testsuite/tests/indexed-types/should_fail/T9171.stderr index db44dd7185..0f70348850 100644 --- a/testsuite/tests/indexed-types/should_fail/T9171.stderr +++ b/testsuite/tests/indexed-types/should_fail/T9171.stderr @@ -2,7 +2,7 @@ T9171.hs:10:20: error: • Couldn't match expected type ‘GetParam Base (GetParam Base Int)’ with actual type ‘GetParam Base (GetParam Base Int)’ - NB: ‘GetParam’ is a type function, and may not be injective + NB: ‘GetParam’ is a non-injective type family The type variable ‘k20’ is ambiguous Use -fprint-explicit-kinds to see the kind arguments • In the ambiguity check for an expression type signature diff --git a/testsuite/tests/indexed-types/should_fail/T9371.stderr b/testsuite/tests/indexed-types/should_fail/T9371.stderr index 729ee3a8c0..9207ac5ae2 100644 --- a/testsuite/tests/indexed-types/should_fail/T9371.stderr +++ b/testsuite/tests/indexed-types/should_fail/T9371.stderr @@ -1,5 +1,5 @@ -T9371.hs:14:10: +T9371.hs:14:10: error: Conflicting family instance declarations: - D = D1 (Either x ()) -- Defined at T9371.hs:14:10 - D (x, y) = D2 (x, y) -- Defined at T9371.hs:18:10 + D x -- Defined at T9371.hs:14:10 + D (x, y) -- Defined at T9371.hs:18:10 diff --git a/testsuite/tests/indexed-types/should_fail/T9662.hs b/testsuite/tests/indexed-types/should_fail/T9662.hs index 2972eca22f..8563c90403 100644 --- a/testsuite/tests/indexed-types/should_fail/T9662.hs +++ b/testsuite/tests/indexed-types/should_fail/T9662.hs @@ -4,10 +4,12 @@ module T9662 where +import Data.Kind (Type) + data Exp a = Exp data (a:.b) = a:.b -type family Plain e :: * +type family Plain e :: Type type instance Plain (Exp a) = a type instance Plain (a:.b) = Plain a :. Plain b diff --git a/testsuite/tests/indexed-types/should_fail/T9662.stderr b/testsuite/tests/indexed-types/should_fail/T9662.stderr index 54b05665a3..4f35d92b5e 100644 --- a/testsuite/tests/indexed-types/should_fail/T9662.stderr +++ b/testsuite/tests/indexed-types/should_fail/T9662.stderr @@ -1,11 +1,11 @@ -T9662.hs:47:8: error: +T9662.hs:49:8: error: • Couldn't match type ‘k’ with ‘Int’ ‘k’ is a rigid type variable bound by the type signature for: test :: forall sh k m n. Shape (((sh :. k) :. m) :. n) -> Shape (((sh :. m) :. n) :. k) - at T9662.hs:44:1-50 + at T9662.hs:46:1-50 Expected type: Exp (((sh :. m) :. n) :. k) -> Exp (((sh :. m) :. n) :. k) Actual type: Exp @@ -32,4 +32,4 @@ T9662.hs:47:8: error: • Relevant bindings include test :: Shape (((sh :. k) :. m) :. n) -> Shape (((sh :. m) :. n) :. k) - (bound at T9662.hs:45:1) + (bound at T9662.hs:47:1) diff --git a/testsuite/tests/indexed-types/should_fail/TyFamArity1.stderr b/testsuite/tests/indexed-types/should_fail/TyFamArity1.stderr index 8b3d5f5910..46521deeba 100644 --- a/testsuite/tests/indexed-types/should_fail/TyFamArity1.stderr +++ b/testsuite/tests/indexed-types/should_fail/TyFamArity1.stderr @@ -1,6 +1,4 @@ -TyFamArity1.hs:4:23: error: - • Expecting one more argument to ‘IO’ - Expected a type, but ‘IO’ has kind ‘* -> *’ - • In the type ‘IO’ - In the type instance declaration for ‘T’ +TyFamArity1.hs:4:15: error: + • Number of parameters must match family declaration; expected 2 + • In the type instance declaration for ‘T’ diff --git a/testsuite/tests/indexed-types/should_fail/TyFamArity2.stderr b/testsuite/tests/indexed-types/should_fail/TyFamArity2.stderr index 778d8ab9f4..8d48921946 100644 --- a/testsuite/tests/indexed-types/should_fail/TyFamArity2.stderr +++ b/testsuite/tests/indexed-types/should_fail/TyFamArity2.stderr @@ -1,11 +1,4 @@ TyFamArity2.hs:4:15: error: - • Too many parameters to T: - Float is unexpected; - expected only one parameter + • Number of parameters must match family declaration; expected 1 • In the type instance declaration for ‘T’ - -TyFamArity2.hs:4:29: error: - • Expected kind ‘* -> *’, but ‘Char’ has kind ‘*’ - • In the type ‘Char’ - In the type instance declaration for ‘T’ diff --git a/testsuite/tests/indexed-types/should_fail/TyFamUndec.stderr b/testsuite/tests/indexed-types/should_fail/TyFamUndec.stderr index 04dd2d3e1a..4ac7e2537c 100644 --- a/testsuite/tests/indexed-types/should_fail/TyFamUndec.stderr +++ b/testsuite/tests/indexed-types/should_fail/TyFamUndec.stderr @@ -1,13 +1,14 @@ TyFamUndec.hs:6:15: error: • Variable ‘b’ occurs more often - in the type family application ‘T (b, b)’ than in the instance head + in the type family application ‘T (b, b)’ + than in the instance head ‘T (a, [b])’ (Use UndecidableInstances to permit this) • In the type instance declaration for ‘T’ TyFamUndec.hs:7:15: error: • The type family application ‘T (a, Maybe b)’ - is no smaller than the instance head + is no smaller than the instance head ‘T (a, Maybe b)’ (Use UndecidableInstances to permit this) • In the type instance declaration for ‘T’ diff --git a/testsuite/tests/indexed-types/should_fail/all.T b/testsuite/tests/indexed-types/should_fail/all.T index 50257e6bb8..11e9d0a65d 100644 --- a/testsuite/tests/indexed-types/should_fail/all.T +++ b/testsuite/tests/indexed-types/should_fail/all.T @@ -87,7 +87,6 @@ test('T7536', normal, compile_fail, ['']) test('T7729', normal, compile_fail, ['']) test('T7729a', normal, compile_fail, ['']) -test('T7786', normal, compile_fail, ['']) test('NoGood', normal, compile_fail, ['']) test('T7967', normal, compile_fail, ['']) @@ -135,3 +134,13 @@ test('T7102a', normal, ghci_script, ['T7102a.script']) test('T13271', normal, compile_fail, ['']) test('T13674', normal, compile_fail, ['']) test('T13784', normal, compile_fail, ['']) +test('T13877', normal, compile_fail, ['']) +test('T13972', normal, compile_fail, ['']) +test('T14033', normal, compile_fail, ['']) +test('T14045a', normal, compile_fail, ['']) +test('T14175', normal, compile_fail, ['']) +test('T14179', normal, compile_fail, ['']) +test('T14246', normal, compile_fail, ['']) +test('T14369', normal, compile_fail, ['']) +test('T15172', normal, compile_fail, ['']) +test('T14904', normal, compile_fail, ['']) diff --git a/testsuite/tests/indexed-types/should_run/T11465a.hs b/testsuite/tests/indexed-types/should_run/T11465a.hs index d3626cf198..93d72545e3 100644 --- a/testsuite/tests/indexed-types/should_run/T11465a.hs +++ b/testsuite/tests/indexed-types/should_run/T11465a.hs @@ -2,7 +2,6 @@ {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE MagicHash #-} {-# LANGUAGE DataKinds #-} -{-# LANGUAGE TypeInType #-} import GHC.Exts import GHC.Types diff --git a/testsuite/tests/lib/integer/integerGmpInternals.hs b/testsuite/tests/lib/integer/integerGmpInternals.hs index 628f8e00fc..e45c6f4a48 100644 --- a/testsuite/tests/lib/integer/integerGmpInternals.hs +++ b/testsuite/tests/lib/integer/integerGmpInternals.hs @@ -20,13 +20,11 @@ import qualified GHC.Integer.GMP.Internals as I recipModInteger :: Integer -> Integer -> Integer recipModInteger = I.recipModInteger --- FIXME: Lacks GMP2 version gcdExtInteger :: Integer -> Integer -> (Integer, Integer) gcdExtInteger a b = case I.gcdExtInteger a b of (# g, s #) -> (g, s) --- FIXME: Lacks GMP2 version powModSecInteger :: Integer -> Integer -> Integer -> Integer -powModSecInteger = powModInteger +powModSecInteger = I.powModSecInteger powModInteger :: Integer -> Integer -> Integer -> Integer powModInteger = I.powModInteger @@ -81,14 +79,36 @@ main = do print $ powModInteger b e m print $ powModInteger b e (m-1) print $ powModSecInteger b e (m-1) + + putStrLn "\n# gcdExtInteger" print $ gcdExtInteger b e print $ gcdExtInteger e b print $ gcdExtInteger x y print $ gcdExtInteger y x + print $ gcdExtInteger x (-y) + print $ gcdExtInteger (-x) y + print $ gcdExtInteger (-x) (-y) + + -- see Trac #15350 + do + let a = 2 + b = 2^65 + 1 + print $ gcdExtInteger a b + print $ gcdExtInteger a (-b) + print $ gcdExtInteger (-a) b + print $ gcdExtInteger (-a) (-b) + print $ gcdExtInteger b a + print $ gcdExtInteger b (-a) + print $ gcdExtInteger (-b) a + print $ gcdExtInteger (-b) (-a) + + putStrLn "\n# powInteger" print $ powInteger 12345 0 print $ powInteger 12345 1 print $ powInteger 12345 30 - print $ [ (x,i) | x <- [0..71], let i = recipModInteger x (2*3*11*11*17*17), i /= 0 ] + print $ [ (x,i) | x <- [-7..71], let i = recipModInteger x (2*3*11*11*17*17), i /= 0 ] + + putStrLn "\n# nextPrimeInteger" print $ I.nextPrimeInteger b print $ I.nextPrimeInteger e print $ [ k | k <- [ 0 .. 200 ], S# (I.testPrimeInteger k 25#) `elem` [1,2] ] diff --git a/testsuite/tests/lib/integer/integerGmpInternals.stdout b/testsuite/tests/lib/integer/integerGmpInternals.stdout index e5cf7f6280..cff835bd27 100644 --- a/testsuite/tests/lib/integer/integerGmpInternals.stdout +++ b/testsuite/tests/lib/integer/integerGmpInternals.stdout @@ -1,14 +1,31 @@ 1527229998585248450016808958343740453059 682382427572745901624116300491295556924 682382427572745901624116300491295556924 + +# gcdExtInteger (1,-238164827888328100873319793437342927637138278785737103723156342382925) (1,302679100340807588460107986194035692812415103244388831792688023418704) (92889294,115110207004456909698806038261) (92889294,-19137667681784054624628973533) +(92889294,115110207004456909698806038261) +(92889294,-115110207004456909698806038261) +(92889294,-115110207004456909698806038261) +(1,-18446744073709551616) +(1,-18446744073709551616) +(1,18446744073709551616) +(1,18446744073709551616) +(1,1) +(1,1) +(1,-1) +(1,-1) + +# powInteger 1 12345 555562377826831043419246079513769804614412256811161773362797946971665712715296306339052301636736176350153982639312744140625 -[(1,1),(5,41963),(7,59947),(13,177535),(19,143557),(23,182447),(25,134281),(29,7235),(31,33841),(35,95915),(37,113413),(41,61409),(43,24397),(47,174101),(49,158431),(53,193979),(59,188477),(61,185737),(65,35507),(67,118999),(71,186173)] +[(-7,149867),(-5,167851),(-1,209813),(1,1),(5,41963),(7,59947),(13,177535),(19,143557),(23,182447),(25,134281),(29,7235),(31,33841),(35,95915),(37,113413),(41,61409),(43,24397),(47,174101),(49,158431),(53,193979),(59,188477),(61,185737),(65,35507),(67,118999),(71,186173)] + +# nextPrimeInteger 2988348162058574136915891421498819466320163312926952423791023078876343 2351399303373464486466122544523690094744975233415544072992656881240451 [2,3,5,7,11,13,17,19,23,29,31,37,41,43,47,53,59,61,67,71,73,79,83,89,97,101,103,107,109,113,127,131,137,139,149,151,157,163,167,173,179,181,191,193,197,199] diff --git a/testsuite/tests/mdo/should_fail/mdofail006.stderr b/testsuite/tests/mdo/should_fail/mdofail006.stderr index ea186c0076..e2cf503df7 100644 --- a/testsuite/tests/mdo/should_fail/mdofail006.stderr +++ b/testsuite/tests/mdo/should_fail/mdofail006.stderr @@ -1 +1 @@ -mdofail006: thread blocked indefinitely in an MVar operation +mdofail006: cyclic evaluation in fixIO diff --git a/testsuite/tests/module/all.T b/testsuite/tests/module/all.T index 5404f19e4a..e862413897 100644 --- a/testsuite/tests/module/all.T +++ b/testsuite/tests/module/all.T @@ -179,7 +179,7 @@ test('mod131', [extra_files(['Mod131_A.hs', 'Mod131_B.hs'])], multimod_compile_f test('mod132', [extra_files(['Mod132_A.hs', 'Mod132_B.hs'])], multimod_compile_fail, ['mod132', '-v0']) -test('mod133', reqlib('mtl'), compile, ['']) +test('mod133', normal, compile, ['']) test('mod134', normal, compile_fail, ['']) test('mod135', normal, compile_fail, ['']) test('mod136', [extra_files(['Mod136_A.hs'])], multimod_compile_fail, ['mod136', '-v0']) @@ -264,7 +264,7 @@ test('mod179', [extra_files(['Mod179_A.hs'])], multimod_compile, ['mod179', '-v0 test('mod180', [extra_files(['Mod180_A.hs', 'Mod180_B.hs'])], multimod_compile_fail, ['mod180', '-v0']) test('T1148', normal, compile, ['']) -test('T1074', reqlib('mtl'), compile, ['']) +test('T1074', normal, compile, ['']) test('T1074a', normal, compile, ['']) test('T2267', reqlib('utf8-string'), compile, ['']) test('T414', normal, compile_fail, ['']) diff --git a/testsuite/tests/module/mod1.stderr b/testsuite/tests/module/mod1.stderr index 50554ae4c6..9bcff0bc5d 100644 --- a/testsuite/tests/module/mod1.stderr +++ b/testsuite/tests/module/mod1.stderr @@ -1,4 +1,4 @@ mod1.hs:3:1: error: Could not find module ‘N’ - Use -v to see a list of the files searched for. + Use -v (or `:set -v` in ghci) to see a list of the files searched for. diff --git a/testsuite/tests/module/mod135.stderr b/testsuite/tests/module/mod135.stderr index a08f93cb67..197bc93c54 100644 --- a/testsuite/tests/module/mod135.stderr +++ b/testsuite/tests/module/mod135.stderr @@ -1,2 +1,3 @@ -mod135.hs:2:11: The export item `module Data.List' is not imported +mod135.hs:2:11: error: + The export item ‘module Data.List’ is not imported diff --git a/testsuite/tests/module/mod2.stderr b/testsuite/tests/module/mod2.stderr index a070917fc4..d9d07168b7 100644 --- a/testsuite/tests/module/mod2.stderr +++ b/testsuite/tests/module/mod2.stderr @@ -1,4 +1,4 @@ mod2.hs:3:1: error: Could not find module ‘N’ - Use -v to see a list of the files searched for. + Use -v (or `:set -v` in ghci) to see a list of the files searched for. diff --git a/testsuite/tests/module/mod39.stderr b/testsuite/tests/module/mod39.stderr index 11aa05256e..95aaddbac5 100644 --- a/testsuite/tests/module/mod39.stderr +++ b/testsuite/tests/module/mod39.stderr @@ -2,6 +2,6 @@ mod39.hs:3:17: error: • Constraint ‘Eq a’ in the type of ‘f’ constrains only the class type variables - Use ConstrainedClassMethods to allow it + Enable ConstrainedClassMethods to allow it • When checking the class method: f :: forall a. (C a, Eq a) => a In the class declaration for ‘C’ diff --git a/testsuite/tests/module/mod71.stderr b/testsuite/tests/module/mod71.stderr index 7c95534256..d877e397a0 100644 --- a/testsuite/tests/module/mod71.stderr +++ b/testsuite/tests/module/mod71.stderr @@ -10,3 +10,4 @@ mod71.hs:4:9: error: • Relevant bindings include x :: t1 -> t -> t2 (bound at mod71.hs:4:3) f :: (t1 -> t -> t2) -> t2 (bound at mod71.hs:4:1) + Constraints include Num t (from mod71.hs:4:1-11) diff --git a/testsuite/tests/module/mod8.stderr b/testsuite/tests/module/mod8.stderr index cba84c8502..d06d6903ac 100644 --- a/testsuite/tests/module/mod8.stderr +++ b/testsuite/tests/module/mod8.stderr @@ -1,2 +1,2 @@ -mod8.hs:2:10: The export item `module N' is not imported +mod8.hs:2:10: error: The export item ‘module N’ is not imported diff --git a/testsuite/tests/module/mod81.stderr b/testsuite/tests/module/mod81.stderr index a1cb2f5bcb..0c07e6dfaa 100644 --- a/testsuite/tests/module/mod81.stderr +++ b/testsuite/tests/module/mod81.stderr @@ -1,3 +1,3 @@ -mod81.hs:3:16: - Module ‘Prelude’ does not export ‘Either(Left, Right, Foo)’ +mod81.hs:3:16: error: + Module ‘Prelude’ does not export ‘Either(Foo)’ diff --git a/testsuite/tests/module/mod91.stderr b/testsuite/tests/module/mod91.stderr index 5d8bd0b9ff..6b0a9cc737 100644 --- a/testsuite/tests/module/mod91.stderr +++ b/testsuite/tests/module/mod91.stderr @@ -1,3 +1,2 @@ -mod91.hs:3:16: - Module ‘Prelude’ does not export ‘Eq((==), (/=), eq)’ +mod91.hs:3:16: error: Module ‘Prelude’ does not export ‘Eq(eq)’ diff --git a/testsuite/tests/monadfail/MonadFailErrors.stderr b/testsuite/tests/monadfail/MonadFailErrors.stderr index 81ad56c910..27fc3c3cf5 100644 --- a/testsuite/tests/monadfail/MonadFailErrors.stderr +++ b/testsuite/tests/monadfail/MonadFailErrors.stderr @@ -33,19 +33,6 @@ MonadFailErrors.hs:30:5: error: = do Just x <- undefined undefined -MonadFailErrors.hs:44:5: error: - • No instance for (MonadFail (ST s)) - arising from a do statement - with the failable pattern ‘Just x’ - • In a stmt of a 'do' block: Just x <- undefined - In the expression: - do Just x <- undefined - undefined - In an equation for ‘st’: - st - = do Just x <- undefined - undefined - MonadFailErrors.hs:51:5: error: • No instance for (MonadFail ((->) r)) arising from a do statement diff --git a/testsuite/tests/monadfail/MonadFailWarnings.hs b/testsuite/tests/monadfail/MonadFailWarnings.hs index a1d3729222..f540201c53 100644 --- a/testsuite/tests/monadfail/MonadFailWarnings.hs +++ b/testsuite/tests/monadfail/MonadFailWarnings.hs @@ -1,7 +1,7 @@ -- Test purpose: -- Ensure that MonadFail warnings are issued correctly if the warning flag -- is enabled - +{-# LANGUAGE NoMonadFailDesugaring #-} {-# OPTIONS_GHC -Wmissing-monadfail-instances #-} module MonadFailWarnings where diff --git a/testsuite/tests/monadfail/MonadFailWarnings.stderr b/testsuite/tests/monadfail/MonadFailWarnings.stderr index 7471bd9373..7a341fc816 100644 --- a/testsuite/tests/monadfail/MonadFailWarnings.stderr +++ b/testsuite/tests/monadfail/MonadFailWarnings.stderr @@ -33,19 +33,6 @@ MonadFailWarnings.hs:35:5: warning: [-Wmissing-monadfail-instances (in -Wcompat) = do Just x <- undefined undefined -MonadFailWarnings.hs:51:5: warning: [-Wmissing-monadfail-instances (in -Wcompat)] - • No instance for (MonadFail (ST s)) - arising from the failable pattern ‘Just x’ - (this will become an error in a future GHC release) - • In a stmt of a 'do' block: Just x <- undefined - In the expression: - do Just x <- undefined - undefined - In an equation for ‘st’: - st - = do Just x <- undefined - undefined - MonadFailWarnings.hs:59:5: warning: [-Wmissing-monadfail-instances (in -Wcompat)] • No instance for (MonadFail ((->) r)) arising from the failable pattern ‘Just x’ diff --git a/testsuite/tests/monadfail/MonadFailWarningsDisabled.hs b/testsuite/tests/monadfail/MonadFailWarningsDisabled.hs index d3df107a4a..c6fd34a67e 100644 --- a/testsuite/tests/monadfail/MonadFailWarningsDisabled.hs +++ b/testsuite/tests/monadfail/MonadFailWarningsDisabled.hs @@ -2,6 +2,11 @@ -- Make sure that not enabling MonadFail warnings makes code compile just -- as it did in < 8.0 +-- NOTE: starting w/ GHC 8.6 sugaring is turned on by default; so we have +-- to disable to keep supporting this test-case +-- +{-# LANGUAGE NoMonadFailDesugaring #-} + module MonadFailWarnings where import Control.Monad.Fail diff --git a/testsuite/tests/numeric/should_compile/Makefile b/testsuite/tests/numeric/should_compile/Makefile index 34dbe5a51f..522e703b50 100644 --- a/testsuite/tests/numeric/should_compile/Makefile +++ b/testsuite/tests/numeric/should_compile/Makefile @@ -5,3 +5,11 @@ include $(TOP)/mk/test.mk T7116: $(RM) -f T7116.o T7116.hi '$(TEST_HC)' $(TEST_HC_OPTS) -O2 -c -ddump-simpl -dsuppress-uniques T7116.hs + +T14170: + $(RM) -f T14170.o T14170.hi + '$(TEST_HC)' $(TEST_HC_OPTS) -O2 -c -ddump-simpl -dsuppress-uniques T14170.hs + +T14465: + $(RM) -f T14465.o T14465.hi + '$(TEST_HC)' $(TEST_HC_OPTS) -O2 -c -ddump-simpl -dsuppress-uniques T14465.hs diff --git a/testsuite/tests/numeric/should_compile/T14170.hs b/testsuite/tests/numeric/should_compile/T14170.hs new file mode 100644 index 0000000000..b7e854d805 --- /dev/null +++ b/testsuite/tests/numeric/should_compile/T14170.hs @@ -0,0 +1,12 @@ +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeInType #-} + +module NatVal where + +import Data.Proxy +import GHC.TypeLits + +-- test that Nat type literals are statically converted into Integer literals + +foo :: Integer +foo = natVal $ Proxy @0 diff --git a/testsuite/tests/numeric/should_compile/T14170.stdout b/testsuite/tests/numeric/should_compile/T14170.stdout new file mode 100644 index 0000000000..46a86214a5 --- /dev/null +++ b/testsuite/tests/numeric/should_compile/T14170.stdout @@ -0,0 +1,59 @@ + +==================== Tidy Core ==================== +Result size of Tidy Core + = {terms: 16, types: 6, coercions: 0, joins: 0/0} + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +NatVal.$trModule4 :: GHC.Prim.Addr# +[GblId, + Caf=NoCafRefs, + Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}] +NatVal.$trModule4 = "main"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +NatVal.$trModule3 :: GHC.Types.TrName +[GblId, + Caf=NoCafRefs, + Str=m1, + Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 20}] +NatVal.$trModule3 = GHC.Types.TrNameS NatVal.$trModule4 + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +NatVal.$trModule2 :: GHC.Prim.Addr# +[GblId, + Caf=NoCafRefs, + Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 0}] +NatVal.$trModule2 = "NatVal"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +NatVal.$trModule1 :: GHC.Types.TrName +[GblId, + Caf=NoCafRefs, + Str=m1, + Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 20}] +NatVal.$trModule1 = GHC.Types.TrNameS NatVal.$trModule2 + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +NatVal.$trModule :: GHC.Types.Module +[GblId, + Caf=NoCafRefs, + Str=m, + Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 30}] +NatVal.$trModule + = GHC.Types.Module NatVal.$trModule3 NatVal.$trModule1 + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +foo :: Integer +[GblId, + Caf=NoCafRefs, + Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 100 0}] +foo = 0 + + + diff --git a/testsuite/tests/numeric/should_compile/T14465.hs b/testsuite/tests/numeric/should_compile/T14465.hs new file mode 100644 index 0000000000..314aa89c56 --- /dev/null +++ b/testsuite/tests/numeric/should_compile/T14465.hs @@ -0,0 +1,26 @@ +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeInType #-} + +module M where + +import Numeric.Natural +import GHC.Natural + +-- test Natural literals +one :: Natural +one = fromInteger 1 + +plusOne :: Natural -> Natural +plusOne n = n + 1 + +-- a built-in rule should convert this unfolding into a Natural literal in Core +ten :: Natural +ten = wordToNatural 10 + +-- test basic constant folding for Natural +twoTimesTwo :: Natural +twoTimesTwo = 2 * 2 + +-- test the overflow warning +minusOne :: Natural +minusOne = -1 diff --git a/testsuite/tests/numeric/should_compile/T14465.stderr b/testsuite/tests/numeric/should_compile/T14465.stderr new file mode 100644 index 0000000000..c21e4a0269 --- /dev/null +++ b/testsuite/tests/numeric/should_compile/T14465.stderr @@ -0,0 +1,3 @@ + +T14465.hs:26:13: warning: [-Woverflowed-literals (in -Wdefault)] + Literal -1 is negative but Natural only supports positive numbers diff --git a/testsuite/tests/numeric/should_compile/T14465.stdout b/testsuite/tests/numeric/should_compile/T14465.stdout new file mode 100644 index 0000000000..e6dfa5fc6c --- /dev/null +++ b/testsuite/tests/numeric/should_compile/T14465.stdout @@ -0,0 +1,104 @@ + +==================== Tidy Core ==================== +Result size of Tidy Core + = {terms: 34, types: 14, coercions: 0, joins: 0/0} + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +ten :: Natural +[GblId, + Caf=NoCafRefs, + Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 100 0}] +ten = 10 + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +M.$trModule4 :: GHC.Prim.Addr# +[GblId, + Caf=NoCafRefs, + Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}] +M.$trModule4 = "main"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +M.$trModule3 :: GHC.Types.TrName +[GblId, + Caf=NoCafRefs, + Str=m1, + Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 20}] +M.$trModule3 = GHC.Types.TrNameS M.$trModule4 + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +M.$trModule2 :: GHC.Prim.Addr# +[GblId, + Caf=NoCafRefs, + Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}] +M.$trModule2 = "M"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +M.$trModule1 :: GHC.Types.TrName +[GblId, + Caf=NoCafRefs, + Str=m1, + Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 20}] +M.$trModule1 = GHC.Types.TrNameS M.$trModule2 + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +M.$trModule :: GHC.Types.Module +[GblId, + Caf=NoCafRefs, + Str=m, + Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 30}] +M.$trModule = GHC.Types.Module M.$trModule3 M.$trModule1 + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +M.minusOne1 :: Natural +[GblId, + Caf=NoCafRefs, + Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 100 0}] +M.minusOne1 = 1 + +-- RHS size: {terms: 6, types: 1, coercions: 0, joins: 0/0} +minusOne :: Natural +[GblId, + Unf=Unf{Src=<vanilla>, TopLvl=True, Value=False, ConLike=False, + WorkFree=False, Expandable=False, Guidance=IF_ARGS [] 40 20}] +minusOne + = case GHC.Natural.$wnegateNatural M.minusOne1 of ww { __DEFAULT -> + GHC.Natural.NatS# ww + } + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +twoTimesTwo :: Natural +[GblId, + Caf=NoCafRefs, + Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 100 0}] +twoTimesTwo = 4 + +-- RHS size: {terms: 4, types: 1, coercions: 0, joins: 0/0} +plusOne :: Natural -> Natural +[GblId, + Arity=1, + Caf=NoCafRefs, + Str=<S,U>, + Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, + Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=False) + Tmpl= \ (n [Occ=Once] :: Natural) -> plusNatural n M.minusOne1}] +plusOne = \ (n :: Natural) -> plusNatural n M.minusOne1 + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +one [InlPrag=NOUSERINLINE[2]] :: Natural +[GblId, + Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, + Guidance=ALWAYS_IF(arity=0,unsat_ok=True,boring_ok=True)}] +one = M.minusOne1 + + + diff --git a/testsuite/tests/numeric/should_compile/T7116.stdout b/testsuite/tests/numeric/should_compile/T7116.stdout index 681d171350..fc0159a1ec 100644 --- a/testsuite/tests/numeric/should_compile/T7116.stdout +++ b/testsuite/tests/numeric/should_compile/T7116.stdout @@ -65,7 +65,7 @@ dr case x of { GHC.Types.D# x1 -> GHC.Types.D# (GHC.Prim.+## x1 x1) } -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} -dl :: Double -> Double +dl [InlPrag=NOUSERINLINE[2]] :: Double -> Double [GblId, Arity=1, Caf=NoCafRefs, @@ -97,7 +97,7 @@ fr } -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} -fl :: Float -> Float +fl [InlPrag=NOUSERINLINE[2]] :: Float -> Float [GblId, Arity=1, Caf=NoCafRefs, diff --git a/testsuite/tests/numeric/should_compile/all.T b/testsuite/tests/numeric/should_compile/all.T index ea42aad5d8..5011627407 100644 --- a/testsuite/tests/numeric/should_compile/all.T +++ b/testsuite/tests/numeric/should_compile/all.T @@ -1,5 +1,10 @@ test('T7116', normal, run_command, ['$MAKE -s --no-print-directory T7116']) +test('T14170', normal, run_command, ['$MAKE -s --no-print-directory T14170']) +test('T14465', normal, run_command, ['$MAKE -s --no-print-directory T14465']) test('T7895', normal, compile, ['']) test('T7881', normal, compile, ['']) -test('T8542', normal, compile, ['']) +# For T8542, the hpc way adds extra annotations that prevent +# the appropriate expression to be detected, after +# desugaring, so we don't get the warning we expect. +test('T8542', omit_ways(['hpc']), compile, ['']) test('T10929', normal, compile, ['']) diff --git a/testsuite/tests/numeric/should_run/FloatFnInverses.hs b/testsuite/tests/numeric/should_run/FloatFnInverses.hs new file mode 100644 index 0000000000..13bf873407 --- /dev/null +++ b/testsuite/tests/numeric/should_run/FloatFnInverses.hs @@ -0,0 +1,56 @@ +{-# LANGUAGE TypeApplications #-} + +-- Check that the standard analytic functions are correctly +-- inverted by the corresponding inverse functions. + +main :: IO () +main = mapM_ print + [ -- @recip@ is self-inverse on @ℝ\\{0}@. + invDeviation @Double recip recip <$> [-1e20, -1e3, -1, -1e-40, 1e-40, 1e90] + , invDeviation @Float recip recip <$> [-1e10, -10, -1, -1e-20, 1e-20, 1e30] + , -- @exp@ is invertible on @ℝ <-> [0…∞[@, but grows very fast. + invDeviation @Double exp log <$> [-10, -5 .. 300] + , invDeviation @Float exp log <$> [-10 .. 60] + -- @sin@ is only invertible on @[-π/2…π/2] <-> [-1…1]@. + , invDeviation @Double sin asin <$> [-1.5, -1.4 .. 1.5] + , invDeviation @Float sin asin <$> [-1.5, -1.4 .. 1.5] + -- @cos@ is invertible on @[0…π] <-> [-1…1]@. + , invDeviation @Double cos acos <$> [0, 0.1 .. 3] + , invDeviation @Float cos acos <$> [0, 0.1 .. 3] + -- @tan@ is invertible on @]-π/4…π/4[ <-> ]-∞…∞[@. + , invDeviation @Double tan atan <$> [-0.7, -0.6 .. 0.7] + , invDeviation @Float tan atan <$> [-0.7, -0.6 .. 0.7] + -- @sinh@ is invertible on @ℝ <-> ℝ@, but grows very fast. + , invDeviation @Double sinh asinh <$> [-700, -672 .. 700] + , invDeviation @Float sinh asinh <$> [-80, -71 .. 80] + -- @cosh@ is invertible on @[0…∞[ <-> [1…∞[@, but grows fast + , invDeviation @Double cosh acosh <$> [0, 15 .. 700] + , invDeviation @Float cosh acosh <$> [0, 15 .. 80] + -- @tanh@ is invertible on @ℝ <-> ]-1…1[@. + , invDeviation @Double atanh tanh <$> [-0.99, -0.87 .. 0.9] + , invDeviation @Float atanh tanh <$> [-0.99, -0.87 .. 0.9] + ] + +invDeviation :: KnownNumDeviation a + => (a -> a) -- ^ Some numerical function @f@. + -> (a -> a) -- ^ Inverse @g = f⁻¹@ of that function. + -> a -- ^ Value @x@ which to compare with @g (f x)@. + -> Double -- ^ Relative discrepancy between original/expected + -- value and actual function result. +invDeviation f g 0 = rmNumericDeviation (g (f 0) + 1) - 1 +invDeviation f g x = rmNumericDeviation (g (f x) / x) - 1 + +-- | We need to round results to some sensible precision, +-- because floating-point arithmetic generally makes +-- it impossible to /exactly/ invert functions. +-- What precision this is depends on the type. The bounds +-- here are rather generous; the functions should usually +-- perform substantially better than that. +class (Floating a, Eq a) => KnownNumDeviation a where + rmNumericDeviation :: a -> Double + +instance KnownNumDeviation Double where + rmNumericDeviation x = fromIntegral (round $ x * 2^36) / 2^36 + +instance KnownNumDeviation Float where + rmNumericDeviation x = fromIntegral (round $ x * 2^16) / 2^16 diff --git a/testsuite/tests/numeric/should_run/FloatFnInverses.stdout b/testsuite/tests/numeric/should_run/FloatFnInverses.stdout new file mode 100644 index 0000000000..2d019b8434 --- /dev/null +++ b/testsuite/tests/numeric/should_run/FloatFnInverses.stdout @@ -0,0 +1,16 @@ +[0.0,0.0,0.0,0.0,0.0,0.0] +[0.0,0.0,0.0,0.0,0.0,0.0] +[0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0] +[0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0] +[0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0] +[0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0] +[0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0] +[0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0] +[0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0] +[0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0] +[0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0] +[0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0] +[0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0] +[0.0,0.0,0.0,0.0,0.0,0.0] +[0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0] +[0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0] diff --git a/testsuite/tests/numeric/should_run/T10962.hs b/testsuite/tests/numeric/should_run/T10962.hs index 896c9e987f..435f3637d7 100644 --- a/testsuite/tests/numeric/should_run/T10962.hs +++ b/testsuite/tests/numeric/should_run/T10962.hs @@ -1,16 +1,32 @@ {-# LANGUAGE MagicHash #-} {-# LANGUAGE UnboxedTuples #-} -module Main where +module Main (main) where import GHC.Base +unW# :: Word -> Word# +unW# (W# w) = w + +type WordOpC = Word# -> Word# -> (# Word#, Int# #) + +check :: WordOpC -> Word# -> Word# -> IO () +check op a b = do + let (# w, c #) = op a b + print (W# w, I# c) + +checkSubInlNoInl :: WordOpC -> Word# -> Word# -> IO () +checkSubInlNoInl op a b = do + inline check op a b -- constant folding + noinline check op a b -- lowering of PrimOp +{-# INLINE checkSubInlNoInl #-} + main :: IO () main = do -- Overflow. - let (# w1, i1 #) = subWordC# 1## 3## - print (W# w1, I# i1) + checkSubInlNoInl subWordC# 1## 3## + checkSubInlNoInl addWordC# (unW# (inline maxBound)) 3## -- No overflow. - let (# w2, i2 #) = subWordC# 3## 1## - print (W# w2, I# i2) + checkSubInlNoInl subWordC# 5## 2## + checkSubInlNoInl addWordC# (unW# (inline maxBound-1)) 1## diff --git a/testsuite/tests/numeric/should_run/T10962.stdout-ws-32 b/testsuite/tests/numeric/should_run/T10962.stdout-ws-32 index a1dec8410a..605265305d 100644 --- a/testsuite/tests/numeric/should_run/T10962.stdout-ws-32 +++ b/testsuite/tests/numeric/should_run/T10962.stdout-ws-32 @@ -1,2 +1,8 @@ (4294967294,1) -(2,0) +(4294967294,1) +(2,1) +(2,1) +(3,0) +(3,0) +(4294967295,0) +(4294967295,0) diff --git a/testsuite/tests/numeric/should_run/T10962.stdout-ws-64 b/testsuite/tests/numeric/should_run/T10962.stdout-ws-64 index 853bf94a61..d36f660eb1 100644 --- a/testsuite/tests/numeric/should_run/T10962.stdout-ws-64 +++ b/testsuite/tests/numeric/should_run/T10962.stdout-ws-64 @@ -1,2 +1,8 @@ (18446744073709551614,1) -(2,0) +(18446744073709551614,1) +(2,1) +(2,1) +(3,0) +(3,0) +(18446744073709551615,0) +(18446744073709551615,0) diff --git a/testsuite/tests/numeric/should_run/T15301.hs b/testsuite/tests/numeric/should_run/T15301.hs new file mode 100644 index 0000000000..6efbce4334 --- /dev/null +++ b/testsuite/tests/numeric/should_run/T15301.hs @@ -0,0 +1,7 @@ +import Numeric +import GHC.Natural + +main = do + -- test that GHC correctly compiles big Natural literals + let x = 0xffffffffffffffffffffffff :: Natural + print (showHex x "" == "ffffffffffffffffffffffff") diff --git a/testsuite/tests/numeric/should_run/T15301.stdout b/testsuite/tests/numeric/should_run/T15301.stdout new file mode 100644 index 0000000000..0ca95142bb --- /dev/null +++ b/testsuite/tests/numeric/should_run/T15301.stdout @@ -0,0 +1 @@ +True diff --git a/testsuite/tests/numeric/should_run/all.T b/testsuite/tests/numeric/should_run/all.T index 2d2353bd8a..140fa6c50b 100644 --- a/testsuite/tests/numeric/should_run/all.T +++ b/testsuite/tests/numeric/should_run/all.T @@ -34,12 +34,15 @@ test('numrun012', normal, compile_and_run, ['']) test('numrun013', normal, compile_and_run, ['']) test('numrun014', normal, compile_and_run, ['']) test('numrun015', normal, compile_and_run, ['']) +test('numrun016', normal, compile_and_run, ['']) test('arith016', normal, compile_and_run, ['']) test('arith017', normal, compile_and_run, ['']) test('arith018', normal, compile_and_run, ['']) test('arith019', normal, compile_and_run, ['']) test('expfloat', normal, compile_and_run, ['']) +test('FloatFnInverses', normal, compile_and_run, ['']) + test('T1603', skip, compile_and_run, ['']) test('T3676', expect_broken(3676), compile_and_run, ['']) test('T4381', normal, compile_and_run, ['']) @@ -59,6 +62,7 @@ test('CarryOverflow', omit_ways(['ghci']), compile_and_run, ['']) test('T9407', normal, compile_and_run, ['']) test('T9810', normal, compile_and_run, ['']) test('T10011', normal, compile_and_run, ['']) -test('T10962', omit_ways(['ghci']), compile_and_run, ['']) +test('T10962', omit_ways(['ghci']), compile_and_run, ['-O2']) test('T11702', extra_ways(['optasm']), compile_and_run, ['']) test('T12136', normal, compile_and_run, ['']) +test('T15301', normal, compile_and_run, ['-O2']) diff --git a/testsuite/tests/numeric/should_run/arith011.hs b/testsuite/tests/numeric/should_run/arith011.hs index 4e23a8d99d..e00caad19a 100644 --- a/testsuite/tests/numeric/should_run/arith011.hs +++ b/testsuite/tests/numeric/should_run/arith011.hs @@ -5,6 +5,8 @@ import Data.Word import Data.Bits import Data.Ix -- added SOF import Control.Exception +import Control.Monad +import Numeric.Natural main :: IO () main = test @@ -21,6 +23,7 @@ test = do testIntlike "Word32" (0::Word32) testIntlike "Word64" (0::Word64) testInteger + testNatural testIntlike :: (Bounded a, Integral a, Ix a, Show a, Read a, Bits a) => String -> a -> IO () testIntlike name zero = do @@ -52,6 +55,20 @@ testInteger = do testIntegral zero testBits zero False +testNatural = do + let zero = 0 :: Natural + putStrLn $ "--------------------------------" + putStrLn $ "--Testing Natural" + putStrLn $ "--------------------------------" + testEnum zero + testReadShow zero + testEq zero + testOrd zero + testNum zero + testReal zero + testIntegral zero + testBits zero False + -- In all these tests, zero is a dummy element used to get -- the overloading to work @@ -81,8 +98,13 @@ testConversions zero = do putStr "Word64 : " >> print (map fromIntegral numbers :: [Word64]) where numbers = [minBound, 0, maxBound] `asTypeOf` [zero] -samples :: (Num a) => a -> [a] -samples zero = map fromInteger ([-3 .. -1]++[0 .. 3]) +isNatural :: (Bits n) => n -> Bool +isNatural zero = not (isSigned zero) && bitSizeMaybe zero == Nothing + +samples :: (Bits a, Num a) => a -> [a] +samples zero + | isNatural zero = map fromInteger [0 .. 3] + | otherwise = map fromInteger ([-3 .. -1]++[0 .. 3]) table1 :: (Show a, Show b) => String -> (a -> b) -> [a] -> IO () table1 nm f xs = do @@ -133,7 +155,9 @@ testNum zero = do table2 "+" (+) xs xs table2 "-" (-) xs xs table2 "*" (*) xs xs - table1 "negate" negate xs + if (isNatural zero) + then table1 "negate" negate [0 `asTypeOf` zero] + else table1 "negate" negate xs where xs = samples zero @@ -159,7 +183,8 @@ testBits zero do_bitsize = do table2 ".&. " (.&.) xs xs table2 ".|. " (.|.) xs xs table2 "`xor`" xor xs xs - table1 "complement" complement xs + unless (isNatural zero) $ + table1 "complement" complement xs table2 "`shiftL`" shiftL xs ([0..3] ++ [32,64]) table2 "`shiftR`" shiftR xs ([0..3] ++ [32,64]) table2 "`rotate`" rotate xs ([-3..3] ++ [-64,-32,32,64]) diff --git a/testsuite/tests/numeric/should_run/arith011.stdout b/testsuite/tests/numeric/should_run/arith011.stdout index 7404c4b353..8a74164f19 100644 --- a/testsuite/tests/numeric/should_run/arith011.stdout +++ b/testsuite/tests/numeric/should_run/arith011.stdout @@ -15416,3 +15416,659 @@ isSigned 1 = True isSigned 2 = True isSigned 3 = True # +-------------------------------- +--Testing Natural +-------------------------------- +testEnum +[0,1,2,3,4,5,6,7,8,9] +[0,2,4,6,8,10,12,14,16,18] +[0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20] +[0,2,4,6,8,10,12,14,16,18,20] +testReadShow +[0,1,2,3] +[0,1,2,3] +testEq +0 == 0 = True +0 == 1 = False +0 == 2 = False +0 == 3 = False + +1 == 0 = False +1 == 1 = True +1 == 2 = False +1 == 3 = False + +2 == 0 = False +2 == 1 = False +2 == 2 = True +2 == 3 = False + +3 == 0 = False +3 == 1 = False +3 == 2 = False +3 == 3 = True + +# +0 /= 0 = False +0 /= 1 = True +0 /= 2 = True +0 /= 3 = True + +1 /= 0 = True +1 /= 1 = False +1 /= 2 = True +1 /= 3 = True + +2 /= 0 = True +2 /= 1 = True +2 /= 2 = False +2 /= 3 = True + +3 /= 0 = True +3 /= 1 = True +3 /= 2 = True +3 /= 3 = False + +# +testOrd +0 <= 0 = True +0 <= 1 = True +0 <= 2 = True +0 <= 3 = True + +1 <= 0 = False +1 <= 1 = True +1 <= 2 = True +1 <= 3 = True + +2 <= 0 = False +2 <= 1 = False +2 <= 2 = True +2 <= 3 = True + +3 <= 0 = False +3 <= 1 = False +3 <= 2 = False +3 <= 3 = True + +# +0 < 0 = False +0 < 1 = True +0 < 2 = True +0 < 3 = True + +1 < 0 = False +1 < 1 = False +1 < 2 = True +1 < 3 = True + +2 < 0 = False +2 < 1 = False +2 < 2 = False +2 < 3 = True + +3 < 0 = False +3 < 1 = False +3 < 2 = False +3 < 3 = False + +# +0 > 0 = False +0 > 1 = False +0 > 2 = False +0 > 3 = False + +1 > 0 = True +1 > 1 = False +1 > 2 = False +1 > 3 = False + +2 > 0 = True +2 > 1 = True +2 > 2 = False +2 > 3 = False + +3 > 0 = True +3 > 1 = True +3 > 2 = True +3 > 3 = False + +# +0 >= 0 = True +0 >= 1 = False +0 >= 2 = False +0 >= 3 = False + +1 >= 0 = True +1 >= 1 = True +1 >= 2 = False +1 >= 3 = False + +2 >= 0 = True +2 >= 1 = True +2 >= 2 = True +2 >= 3 = False + +3 >= 0 = True +3 >= 1 = True +3 >= 2 = True +3 >= 3 = True + +# +0 `compare` 0 = EQ +0 `compare` 1 = LT +0 `compare` 2 = LT +0 `compare` 3 = LT + +1 `compare` 0 = GT +1 `compare` 1 = EQ +1 `compare` 2 = LT +1 `compare` 3 = LT + +2 `compare` 0 = GT +2 `compare` 1 = GT +2 `compare` 2 = EQ +2 `compare` 3 = LT + +3 `compare` 0 = GT +3 `compare` 1 = GT +3 `compare` 2 = GT +3 `compare` 3 = EQ + +# +testNum +0 + 0 = 0 +0 + 1 = 1 +0 + 2 = 2 +0 + 3 = 3 + +1 + 0 = 1 +1 + 1 = 2 +1 + 2 = 3 +1 + 3 = 4 + +2 + 0 = 2 +2 + 1 = 3 +2 + 2 = 4 +2 + 3 = 5 + +3 + 0 = 3 +3 + 1 = 4 +3 + 2 = 5 +3 + 3 = 6 + +# +0 - 0 = 0 +0 - 1 = arithmetic underflow +0 - 2 = arithmetic underflow +0 - 3 = arithmetic underflow + +1 - 0 = 1 +1 - 1 = 0 +1 - 2 = arithmetic underflow +1 - 3 = arithmetic underflow + +2 - 0 = 2 +2 - 1 = 1 +2 - 2 = 0 +2 - 3 = arithmetic underflow + +3 - 0 = 3 +3 - 1 = 2 +3 - 2 = 1 +3 - 3 = 0 + +# +0 * 0 = 0 +0 * 1 = 0 +0 * 2 = 0 +0 * 3 = 0 + +1 * 0 = 0 +1 * 1 = 1 +1 * 2 = 2 +1 * 3 = 3 + +2 * 0 = 0 +2 * 1 = 2 +2 * 2 = 4 +2 * 3 = 6 + +3 * 0 = 0 +3 * 1 = 3 +3 * 2 = 6 +3 * 3 = 9 + +# +negate 0 = 0 +# +testReal +toRational 0 = 0 % 1 +toRational 1 = 1 % 1 +toRational 2 = 2 % 1 +toRational 3 = 3 % 1 +# +testIntegral +0 `divMod` 0 = divide by zero +0 `divMod` 1 = (0,0) +0 `divMod` 2 = (0,0) +0 `divMod` 3 = (0,0) + +1 `divMod` 0 = divide by zero +1 `divMod` 1 = (1,0) +1 `divMod` 2 = (0,1) +1 `divMod` 3 = (0,1) + +2 `divMod` 0 = divide by zero +2 `divMod` 1 = (2,0) +2 `divMod` 2 = (1,0) +2 `divMod` 3 = (0,2) + +3 `divMod` 0 = divide by zero +3 `divMod` 1 = (3,0) +3 `divMod` 2 = (1,1) +3 `divMod` 3 = (1,0) + +# +0 `div` 0 = divide by zero +0 `div` 1 = 0 +0 `div` 2 = 0 +0 `div` 3 = 0 + +1 `div` 0 = divide by zero +1 `div` 1 = 1 +1 `div` 2 = 0 +1 `div` 3 = 0 + +2 `div` 0 = divide by zero +2 `div` 1 = 2 +2 `div` 2 = 1 +2 `div` 3 = 0 + +3 `div` 0 = divide by zero +3 `div` 1 = 3 +3 `div` 2 = 1 +3 `div` 3 = 1 + +# +0 `mod` 0 = divide by zero +0 `mod` 1 = 0 +0 `mod` 2 = 0 +0 `mod` 3 = 0 + +1 `mod` 0 = divide by zero +1 `mod` 1 = 0 +1 `mod` 2 = 1 +1 `mod` 3 = 1 + +2 `mod` 0 = divide by zero +2 `mod` 1 = 0 +2 `mod` 2 = 0 +2 `mod` 3 = 2 + +3 `mod` 0 = divide by zero +3 `mod` 1 = 0 +3 `mod` 2 = 1 +3 `mod` 3 = 0 + +# +0 `quotRem` 0 = divide by zero +0 `quotRem` 1 = (0,0) +0 `quotRem` 2 = (0,0) +0 `quotRem` 3 = (0,0) + +1 `quotRem` 0 = divide by zero +1 `quotRem` 1 = (1,0) +1 `quotRem` 2 = (0,1) +1 `quotRem` 3 = (0,1) + +2 `quotRem` 0 = divide by zero +2 `quotRem` 1 = (2,0) +2 `quotRem` 2 = (1,0) +2 `quotRem` 3 = (0,2) + +3 `quotRem` 0 = divide by zero +3 `quotRem` 1 = (3,0) +3 `quotRem` 2 = (1,1) +3 `quotRem` 3 = (1,0) + +# +0 `quot` 0 = divide by zero +0 `quot` 1 = 0 +0 `quot` 2 = 0 +0 `quot` 3 = 0 + +1 `quot` 0 = divide by zero +1 `quot` 1 = 1 +1 `quot` 2 = 0 +1 `quot` 3 = 0 + +2 `quot` 0 = divide by zero +2 `quot` 1 = 2 +2 `quot` 2 = 1 +2 `quot` 3 = 0 + +3 `quot` 0 = divide by zero +3 `quot` 1 = 3 +3 `quot` 2 = 1 +3 `quot` 3 = 1 + +# +0 `rem` 0 = divide by zero +0 `rem` 1 = 0 +0 `rem` 2 = 0 +0 `rem` 3 = 0 + +1 `rem` 0 = divide by zero +1 `rem` 1 = 0 +1 `rem` 2 = 1 +1 `rem` 3 = 1 + +2 `rem` 0 = divide by zero +2 `rem` 1 = 0 +2 `rem` 2 = 0 +2 `rem` 3 = 2 + +3 `rem` 0 = divide by zero +3 `rem` 1 = 0 +3 `rem` 2 = 1 +3 `rem` 3 = 0 + +# +testBits +0 .&. 0 = 0 +0 .&. 1 = 0 +0 .&. 2 = 0 +0 .&. 3 = 0 + +1 .&. 0 = 0 +1 .&. 1 = 1 +1 .&. 2 = 0 +1 .&. 3 = 1 + +2 .&. 0 = 0 +2 .&. 1 = 0 +2 .&. 2 = 2 +2 .&. 3 = 2 + +3 .&. 0 = 0 +3 .&. 1 = 1 +3 .&. 2 = 2 +3 .&. 3 = 3 + +# +0 .|. 0 = 0 +0 .|. 1 = 1 +0 .|. 2 = 2 +0 .|. 3 = 3 + +1 .|. 0 = 1 +1 .|. 1 = 1 +1 .|. 2 = 3 +1 .|. 3 = 3 + +2 .|. 0 = 2 +2 .|. 1 = 3 +2 .|. 2 = 2 +2 .|. 3 = 3 + +3 .|. 0 = 3 +3 .|. 1 = 3 +3 .|. 2 = 3 +3 .|. 3 = 3 + +# +0 `xor` 0 = 0 +0 `xor` 1 = 1 +0 `xor` 2 = 2 +0 `xor` 3 = 3 + +1 `xor` 0 = 1 +1 `xor` 1 = 0 +1 `xor` 2 = 3 +1 `xor` 3 = 2 + +2 `xor` 0 = 2 +2 `xor` 1 = 3 +2 `xor` 2 = 0 +2 `xor` 3 = 1 + +3 `xor` 0 = 3 +3 `xor` 1 = 2 +3 `xor` 2 = 1 +3 `xor` 3 = 0 + +# +0 `shiftL` 0 = 0 +0 `shiftL` 1 = 0 +0 `shiftL` 2 = 0 +0 `shiftL` 3 = 0 +0 `shiftL` 32 = 0 +0 `shiftL` 64 = 0 + +1 `shiftL` 0 = 1 +1 `shiftL` 1 = 2 +1 `shiftL` 2 = 4 +1 `shiftL` 3 = 8 +1 `shiftL` 32 = 4294967296 +1 `shiftL` 64 = 18446744073709551616 + +2 `shiftL` 0 = 2 +2 `shiftL` 1 = 4 +2 `shiftL` 2 = 8 +2 `shiftL` 3 = 16 +2 `shiftL` 32 = 8589934592 +2 `shiftL` 64 = 36893488147419103232 + +3 `shiftL` 0 = 3 +3 `shiftL` 1 = 6 +3 `shiftL` 2 = 12 +3 `shiftL` 3 = 24 +3 `shiftL` 32 = 12884901888 +3 `shiftL` 64 = 55340232221128654848 + +# +0 `shiftR` 0 = 0 +0 `shiftR` 1 = 0 +0 `shiftR` 2 = 0 +0 `shiftR` 3 = 0 +0 `shiftR` 32 = 0 +0 `shiftR` 64 = 0 + +1 `shiftR` 0 = 1 +1 `shiftR` 1 = 0 +1 `shiftR` 2 = 0 +1 `shiftR` 3 = 0 +1 `shiftR` 32 = 0 +1 `shiftR` 64 = 0 + +2 `shiftR` 0 = 2 +2 `shiftR` 1 = 1 +2 `shiftR` 2 = 0 +2 `shiftR` 3 = 0 +2 `shiftR` 32 = 0 +2 `shiftR` 64 = 0 + +3 `shiftR` 0 = 3 +3 `shiftR` 1 = 1 +3 `shiftR` 2 = 0 +3 `shiftR` 3 = 0 +3 `shiftR` 32 = 0 +3 `shiftR` 64 = 0 + +# +0 `rotate` -3 = 0 +0 `rotate` -2 = 0 +0 `rotate` -1 = 0 +0 `rotate` 0 = 0 +0 `rotate` 1 = 0 +0 `rotate` 2 = 0 +0 `rotate` 3 = 0 +0 `rotate` -64 = 0 +0 `rotate` -32 = 0 +0 `rotate` 32 = 0 +0 `rotate` 64 = 0 + +1 `rotate` -3 = 0 +1 `rotate` -2 = 0 +1 `rotate` -1 = 0 +1 `rotate` 0 = 1 +1 `rotate` 1 = 2 +1 `rotate` 2 = 4 +1 `rotate` 3 = 8 +1 `rotate` -64 = 0 +1 `rotate` -32 = 0 +1 `rotate` 32 = 4294967296 +1 `rotate` 64 = 18446744073709551616 + +2 `rotate` -3 = 0 +2 `rotate` -2 = 0 +2 `rotate` -1 = 1 +2 `rotate` 0 = 2 +2 `rotate` 1 = 4 +2 `rotate` 2 = 8 +2 `rotate` 3 = 16 +2 `rotate` -64 = 0 +2 `rotate` -32 = 0 +2 `rotate` 32 = 8589934592 +2 `rotate` 64 = 36893488147419103232 + +3 `rotate` -3 = 0 +3 `rotate` -2 = 0 +3 `rotate` -1 = 1 +3 `rotate` 0 = 3 +3 `rotate` 1 = 6 +3 `rotate` 2 = 12 +3 `rotate` 3 = 24 +3 `rotate` -64 = 0 +3 `rotate` -32 = 0 +3 `rotate` 32 = 12884901888 +3 `rotate` 64 = 55340232221128654848 + +# +bit 0 = 1 +bit 1 = 2 +bit 2 = 4 +bit 3 = 8 +# +0 `setBit` 0 = 1 +0 `setBit` 1 = 2 +0 `setBit` 2 = 4 +0 `setBit` 3 = 8 +0 `setBit` 32 = 4294967296 +0 `setBit` 64 = 18446744073709551616 + +1 `setBit` 0 = 1 +1 `setBit` 1 = 3 +1 `setBit` 2 = 5 +1 `setBit` 3 = 9 +1 `setBit` 32 = 4294967297 +1 `setBit` 64 = 18446744073709551617 + +2 `setBit` 0 = 3 +2 `setBit` 1 = 2 +2 `setBit` 2 = 6 +2 `setBit` 3 = 10 +2 `setBit` 32 = 4294967298 +2 `setBit` 64 = 18446744073709551618 + +3 `setBit` 0 = 3 +3 `setBit` 1 = 3 +3 `setBit` 2 = 7 +3 `setBit` 3 = 11 +3 `setBit` 32 = 4294967299 +3 `setBit` 64 = 18446744073709551619 + +# +0 `clearBit` 0 = 0 +0 `clearBit` 1 = 0 +0 `clearBit` 2 = 0 +0 `clearBit` 3 = 0 +0 `clearBit` 32 = 0 +0 `clearBit` 64 = 0 + +1 `clearBit` 0 = 0 +1 `clearBit` 1 = 1 +1 `clearBit` 2 = 1 +1 `clearBit` 3 = 1 +1 `clearBit` 32 = 1 +1 `clearBit` 64 = 1 + +2 `clearBit` 0 = 2 +2 `clearBit` 1 = 0 +2 `clearBit` 2 = 2 +2 `clearBit` 3 = 2 +2 `clearBit` 32 = 2 +2 `clearBit` 64 = 2 + +3 `clearBit` 0 = 2 +3 `clearBit` 1 = 1 +3 `clearBit` 2 = 3 +3 `clearBit` 3 = 3 +3 `clearBit` 32 = 3 +3 `clearBit` 64 = 3 + +# +0 `complementBit` 0 = 1 +0 `complementBit` 1 = 2 +0 `complementBit` 2 = 4 +0 `complementBit` 3 = 8 +0 `complementBit` 32 = 4294967296 +0 `complementBit` 64 = 18446744073709551616 + +1 `complementBit` 0 = 0 +1 `complementBit` 1 = 3 +1 `complementBit` 2 = 5 +1 `complementBit` 3 = 9 +1 `complementBit` 32 = 4294967297 +1 `complementBit` 64 = 18446744073709551617 + +2 `complementBit` 0 = 3 +2 `complementBit` 1 = 0 +2 `complementBit` 2 = 6 +2 `complementBit` 3 = 10 +2 `complementBit` 32 = 4294967298 +2 `complementBit` 64 = 18446744073709551618 + +3 `complementBit` 0 = 2 +3 `complementBit` 1 = 1 +3 `complementBit` 2 = 7 +3 `complementBit` 3 = 11 +3 `complementBit` 32 = 4294967299 +3 `complementBit` 64 = 18446744073709551619 + +# +0 `testBit` 0 = False +0 `testBit` 1 = False +0 `testBit` 2 = False +0 `testBit` 3 = False +0 `testBit` 32 = False +0 `testBit` 64 = False + +1 `testBit` 0 = True +1 `testBit` 1 = False +1 `testBit` 2 = False +1 `testBit` 3 = False +1 `testBit` 32 = False +1 `testBit` 64 = False + +2 `testBit` 0 = False +2 `testBit` 1 = True +2 `testBit` 2 = False +2 `testBit` 3 = False +2 `testBit` 32 = False +2 `testBit` 64 = False + +3 `testBit` 0 = True +3 `testBit` 1 = True +3 `testBit` 2 = False +3 `testBit` 3 = False +3 `testBit` 32 = False +3 `testBit` 64 = False + +# +isSigned 0 = False +isSigned 1 = False +isSigned 2 = False +isSigned 3 = False +# diff --git a/testsuite/tests/numeric/should_run/arith011.stdout-ws-64 b/testsuite/tests/numeric/should_run/arith011.stdout-ws-64 index ff064a071d..cd2e23bd63 100644 --- a/testsuite/tests/numeric/should_run/arith011.stdout-ws-64 +++ b/testsuite/tests/numeric/should_run/arith011.stdout-ws-64 @@ -15416,3 +15416,659 @@ isSigned 1 = True isSigned 2 = True isSigned 3 = True # +-------------------------------- +--Testing Natural +-------------------------------- +testEnum +[0,1,2,3,4,5,6,7,8,9] +[0,2,4,6,8,10,12,14,16,18] +[0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20] +[0,2,4,6,8,10,12,14,16,18,20] +testReadShow +[0,1,2,3] +[0,1,2,3] +testEq +0 == 0 = True +0 == 1 = False +0 == 2 = False +0 == 3 = False + +1 == 0 = False +1 == 1 = True +1 == 2 = False +1 == 3 = False + +2 == 0 = False +2 == 1 = False +2 == 2 = True +2 == 3 = False + +3 == 0 = False +3 == 1 = False +3 == 2 = False +3 == 3 = True + +# +0 /= 0 = False +0 /= 1 = True +0 /= 2 = True +0 /= 3 = True + +1 /= 0 = True +1 /= 1 = False +1 /= 2 = True +1 /= 3 = True + +2 /= 0 = True +2 /= 1 = True +2 /= 2 = False +2 /= 3 = True + +3 /= 0 = True +3 /= 1 = True +3 /= 2 = True +3 /= 3 = False + +# +testOrd +0 <= 0 = True +0 <= 1 = True +0 <= 2 = True +0 <= 3 = True + +1 <= 0 = False +1 <= 1 = True +1 <= 2 = True +1 <= 3 = True + +2 <= 0 = False +2 <= 1 = False +2 <= 2 = True +2 <= 3 = True + +3 <= 0 = False +3 <= 1 = False +3 <= 2 = False +3 <= 3 = True + +# +0 < 0 = False +0 < 1 = True +0 < 2 = True +0 < 3 = True + +1 < 0 = False +1 < 1 = False +1 < 2 = True +1 < 3 = True + +2 < 0 = False +2 < 1 = False +2 < 2 = False +2 < 3 = True + +3 < 0 = False +3 < 1 = False +3 < 2 = False +3 < 3 = False + +# +0 > 0 = False +0 > 1 = False +0 > 2 = False +0 > 3 = False + +1 > 0 = True +1 > 1 = False +1 > 2 = False +1 > 3 = False + +2 > 0 = True +2 > 1 = True +2 > 2 = False +2 > 3 = False + +3 > 0 = True +3 > 1 = True +3 > 2 = True +3 > 3 = False + +# +0 >= 0 = True +0 >= 1 = False +0 >= 2 = False +0 >= 3 = False + +1 >= 0 = True +1 >= 1 = True +1 >= 2 = False +1 >= 3 = False + +2 >= 0 = True +2 >= 1 = True +2 >= 2 = True +2 >= 3 = False + +3 >= 0 = True +3 >= 1 = True +3 >= 2 = True +3 >= 3 = True + +# +0 `compare` 0 = EQ +0 `compare` 1 = LT +0 `compare` 2 = LT +0 `compare` 3 = LT + +1 `compare` 0 = GT +1 `compare` 1 = EQ +1 `compare` 2 = LT +1 `compare` 3 = LT + +2 `compare` 0 = GT +2 `compare` 1 = GT +2 `compare` 2 = EQ +2 `compare` 3 = LT + +3 `compare` 0 = GT +3 `compare` 1 = GT +3 `compare` 2 = GT +3 `compare` 3 = EQ + +# +testNum +0 + 0 = 0 +0 + 1 = 1 +0 + 2 = 2 +0 + 3 = 3 + +1 + 0 = 1 +1 + 1 = 2 +1 + 2 = 3 +1 + 3 = 4 + +2 + 0 = 2 +2 + 1 = 3 +2 + 2 = 4 +2 + 3 = 5 + +3 + 0 = 3 +3 + 1 = 4 +3 + 2 = 5 +3 + 3 = 6 + +# +0 - 0 = 0 +0 - 1 = arithmetic underflow +0 - 2 = arithmetic underflow +0 - 3 = arithmetic underflow + +1 - 0 = 1 +1 - 1 = 0 +1 - 2 = arithmetic underflow +1 - 3 = arithmetic underflow + +2 - 0 = 2 +2 - 1 = 1 +2 - 2 = 0 +2 - 3 = arithmetic underflow + +3 - 0 = 3 +3 - 1 = 2 +3 - 2 = 1 +3 - 3 = 0 + +# +0 * 0 = 0 +0 * 1 = 0 +0 * 2 = 0 +0 * 3 = 0 + +1 * 0 = 0 +1 * 1 = 1 +1 * 2 = 2 +1 * 3 = 3 + +2 * 0 = 0 +2 * 1 = 2 +2 * 2 = 4 +2 * 3 = 6 + +3 * 0 = 0 +3 * 1 = 3 +3 * 2 = 6 +3 * 3 = 9 + +# +negate 0 = 0 +# +testReal +toRational 0 = 0 % 1 +toRational 1 = 1 % 1 +toRational 2 = 2 % 1 +toRational 3 = 3 % 1 +# +testIntegral +0 `divMod` 0 = divide by zero +0 `divMod` 1 = (0,0) +0 `divMod` 2 = (0,0) +0 `divMod` 3 = (0,0) + +1 `divMod` 0 = divide by zero +1 `divMod` 1 = (1,0) +1 `divMod` 2 = (0,1) +1 `divMod` 3 = (0,1) + +2 `divMod` 0 = divide by zero +2 `divMod` 1 = (2,0) +2 `divMod` 2 = (1,0) +2 `divMod` 3 = (0,2) + +3 `divMod` 0 = divide by zero +3 `divMod` 1 = (3,0) +3 `divMod` 2 = (1,1) +3 `divMod` 3 = (1,0) + +# +0 `div` 0 = divide by zero +0 `div` 1 = 0 +0 `div` 2 = 0 +0 `div` 3 = 0 + +1 `div` 0 = divide by zero +1 `div` 1 = 1 +1 `div` 2 = 0 +1 `div` 3 = 0 + +2 `div` 0 = divide by zero +2 `div` 1 = 2 +2 `div` 2 = 1 +2 `div` 3 = 0 + +3 `div` 0 = divide by zero +3 `div` 1 = 3 +3 `div` 2 = 1 +3 `div` 3 = 1 + +# +0 `mod` 0 = divide by zero +0 `mod` 1 = 0 +0 `mod` 2 = 0 +0 `mod` 3 = 0 + +1 `mod` 0 = divide by zero +1 `mod` 1 = 0 +1 `mod` 2 = 1 +1 `mod` 3 = 1 + +2 `mod` 0 = divide by zero +2 `mod` 1 = 0 +2 `mod` 2 = 0 +2 `mod` 3 = 2 + +3 `mod` 0 = divide by zero +3 `mod` 1 = 0 +3 `mod` 2 = 1 +3 `mod` 3 = 0 + +# +0 `quotRem` 0 = divide by zero +0 `quotRem` 1 = (0,0) +0 `quotRem` 2 = (0,0) +0 `quotRem` 3 = (0,0) + +1 `quotRem` 0 = divide by zero +1 `quotRem` 1 = (1,0) +1 `quotRem` 2 = (0,1) +1 `quotRem` 3 = (0,1) + +2 `quotRem` 0 = divide by zero +2 `quotRem` 1 = (2,0) +2 `quotRem` 2 = (1,0) +2 `quotRem` 3 = (0,2) + +3 `quotRem` 0 = divide by zero +3 `quotRem` 1 = (3,0) +3 `quotRem` 2 = (1,1) +3 `quotRem` 3 = (1,0) + +# +0 `quot` 0 = divide by zero +0 `quot` 1 = 0 +0 `quot` 2 = 0 +0 `quot` 3 = 0 + +1 `quot` 0 = divide by zero +1 `quot` 1 = 1 +1 `quot` 2 = 0 +1 `quot` 3 = 0 + +2 `quot` 0 = divide by zero +2 `quot` 1 = 2 +2 `quot` 2 = 1 +2 `quot` 3 = 0 + +3 `quot` 0 = divide by zero +3 `quot` 1 = 3 +3 `quot` 2 = 1 +3 `quot` 3 = 1 + +# +0 `rem` 0 = divide by zero +0 `rem` 1 = 0 +0 `rem` 2 = 0 +0 `rem` 3 = 0 + +1 `rem` 0 = divide by zero +1 `rem` 1 = 0 +1 `rem` 2 = 1 +1 `rem` 3 = 1 + +2 `rem` 0 = divide by zero +2 `rem` 1 = 0 +2 `rem` 2 = 0 +2 `rem` 3 = 2 + +3 `rem` 0 = divide by zero +3 `rem` 1 = 0 +3 `rem` 2 = 1 +3 `rem` 3 = 0 + +# +testBits +0 .&. 0 = 0 +0 .&. 1 = 0 +0 .&. 2 = 0 +0 .&. 3 = 0 + +1 .&. 0 = 0 +1 .&. 1 = 1 +1 .&. 2 = 0 +1 .&. 3 = 1 + +2 .&. 0 = 0 +2 .&. 1 = 0 +2 .&. 2 = 2 +2 .&. 3 = 2 + +3 .&. 0 = 0 +3 .&. 1 = 1 +3 .&. 2 = 2 +3 .&. 3 = 3 + +# +0 .|. 0 = 0 +0 .|. 1 = 1 +0 .|. 2 = 2 +0 .|. 3 = 3 + +1 .|. 0 = 1 +1 .|. 1 = 1 +1 .|. 2 = 3 +1 .|. 3 = 3 + +2 .|. 0 = 2 +2 .|. 1 = 3 +2 .|. 2 = 2 +2 .|. 3 = 3 + +3 .|. 0 = 3 +3 .|. 1 = 3 +3 .|. 2 = 3 +3 .|. 3 = 3 + +# +0 `xor` 0 = 0 +0 `xor` 1 = 1 +0 `xor` 2 = 2 +0 `xor` 3 = 3 + +1 `xor` 0 = 1 +1 `xor` 1 = 0 +1 `xor` 2 = 3 +1 `xor` 3 = 2 + +2 `xor` 0 = 2 +2 `xor` 1 = 3 +2 `xor` 2 = 0 +2 `xor` 3 = 1 + +3 `xor` 0 = 3 +3 `xor` 1 = 2 +3 `xor` 2 = 1 +3 `xor` 3 = 0 + +# +0 `shiftL` 0 = 0 +0 `shiftL` 1 = 0 +0 `shiftL` 2 = 0 +0 `shiftL` 3 = 0 +0 `shiftL` 32 = 0 +0 `shiftL` 64 = 0 + +1 `shiftL` 0 = 1 +1 `shiftL` 1 = 2 +1 `shiftL` 2 = 4 +1 `shiftL` 3 = 8 +1 `shiftL` 32 = 4294967296 +1 `shiftL` 64 = 18446744073709551616 + +2 `shiftL` 0 = 2 +2 `shiftL` 1 = 4 +2 `shiftL` 2 = 8 +2 `shiftL` 3 = 16 +2 `shiftL` 32 = 8589934592 +2 `shiftL` 64 = 36893488147419103232 + +3 `shiftL` 0 = 3 +3 `shiftL` 1 = 6 +3 `shiftL` 2 = 12 +3 `shiftL` 3 = 24 +3 `shiftL` 32 = 12884901888 +3 `shiftL` 64 = 55340232221128654848 + +# +0 `shiftR` 0 = 0 +0 `shiftR` 1 = 0 +0 `shiftR` 2 = 0 +0 `shiftR` 3 = 0 +0 `shiftR` 32 = 0 +0 `shiftR` 64 = 0 + +1 `shiftR` 0 = 1 +1 `shiftR` 1 = 0 +1 `shiftR` 2 = 0 +1 `shiftR` 3 = 0 +1 `shiftR` 32 = 0 +1 `shiftR` 64 = 0 + +2 `shiftR` 0 = 2 +2 `shiftR` 1 = 1 +2 `shiftR` 2 = 0 +2 `shiftR` 3 = 0 +2 `shiftR` 32 = 0 +2 `shiftR` 64 = 0 + +3 `shiftR` 0 = 3 +3 `shiftR` 1 = 1 +3 `shiftR` 2 = 0 +3 `shiftR` 3 = 0 +3 `shiftR` 32 = 0 +3 `shiftR` 64 = 0 + +# +0 `rotate` -3 = 0 +0 `rotate` -2 = 0 +0 `rotate` -1 = 0 +0 `rotate` 0 = 0 +0 `rotate` 1 = 0 +0 `rotate` 2 = 0 +0 `rotate` 3 = 0 +0 `rotate` -64 = 0 +0 `rotate` -32 = 0 +0 `rotate` 32 = 0 +0 `rotate` 64 = 0 + +1 `rotate` -3 = 0 +1 `rotate` -2 = 0 +1 `rotate` -1 = 0 +1 `rotate` 0 = 1 +1 `rotate` 1 = 2 +1 `rotate` 2 = 4 +1 `rotate` 3 = 8 +1 `rotate` -64 = 0 +1 `rotate` -32 = 0 +1 `rotate` 32 = 4294967296 +1 `rotate` 64 = 18446744073709551616 + +2 `rotate` -3 = 0 +2 `rotate` -2 = 0 +2 `rotate` -1 = 1 +2 `rotate` 0 = 2 +2 `rotate` 1 = 4 +2 `rotate` 2 = 8 +2 `rotate` 3 = 16 +2 `rotate` -64 = 0 +2 `rotate` -32 = 0 +2 `rotate` 32 = 8589934592 +2 `rotate` 64 = 36893488147419103232 + +3 `rotate` -3 = 0 +3 `rotate` -2 = 0 +3 `rotate` -1 = 1 +3 `rotate` 0 = 3 +3 `rotate` 1 = 6 +3 `rotate` 2 = 12 +3 `rotate` 3 = 24 +3 `rotate` -64 = 0 +3 `rotate` -32 = 0 +3 `rotate` 32 = 12884901888 +3 `rotate` 64 = 55340232221128654848 + +# +bit 0 = 1 +bit 1 = 2 +bit 2 = 4 +bit 3 = 8 +# +0 `setBit` 0 = 1 +0 `setBit` 1 = 2 +0 `setBit` 2 = 4 +0 `setBit` 3 = 8 +0 `setBit` 32 = 4294967296 +0 `setBit` 64 = 18446744073709551616 + +1 `setBit` 0 = 1 +1 `setBit` 1 = 3 +1 `setBit` 2 = 5 +1 `setBit` 3 = 9 +1 `setBit` 32 = 4294967297 +1 `setBit` 64 = 18446744073709551617 + +2 `setBit` 0 = 3 +2 `setBit` 1 = 2 +2 `setBit` 2 = 6 +2 `setBit` 3 = 10 +2 `setBit` 32 = 4294967298 +2 `setBit` 64 = 18446744073709551618 + +3 `setBit` 0 = 3 +3 `setBit` 1 = 3 +3 `setBit` 2 = 7 +3 `setBit` 3 = 11 +3 `setBit` 32 = 4294967299 +3 `setBit` 64 = 18446744073709551619 + +# +0 `clearBit` 0 = 0 +0 `clearBit` 1 = 0 +0 `clearBit` 2 = 0 +0 `clearBit` 3 = 0 +0 `clearBit` 32 = 0 +0 `clearBit` 64 = 0 + +1 `clearBit` 0 = 0 +1 `clearBit` 1 = 1 +1 `clearBit` 2 = 1 +1 `clearBit` 3 = 1 +1 `clearBit` 32 = 1 +1 `clearBit` 64 = 1 + +2 `clearBit` 0 = 2 +2 `clearBit` 1 = 0 +2 `clearBit` 2 = 2 +2 `clearBit` 3 = 2 +2 `clearBit` 32 = 2 +2 `clearBit` 64 = 2 + +3 `clearBit` 0 = 2 +3 `clearBit` 1 = 1 +3 `clearBit` 2 = 3 +3 `clearBit` 3 = 3 +3 `clearBit` 32 = 3 +3 `clearBit` 64 = 3 + +# +0 `complementBit` 0 = 1 +0 `complementBit` 1 = 2 +0 `complementBit` 2 = 4 +0 `complementBit` 3 = 8 +0 `complementBit` 32 = 4294967296 +0 `complementBit` 64 = 18446744073709551616 + +1 `complementBit` 0 = 0 +1 `complementBit` 1 = 3 +1 `complementBit` 2 = 5 +1 `complementBit` 3 = 9 +1 `complementBit` 32 = 4294967297 +1 `complementBit` 64 = 18446744073709551617 + +2 `complementBit` 0 = 3 +2 `complementBit` 1 = 0 +2 `complementBit` 2 = 6 +2 `complementBit` 3 = 10 +2 `complementBit` 32 = 4294967298 +2 `complementBit` 64 = 18446744073709551618 + +3 `complementBit` 0 = 2 +3 `complementBit` 1 = 1 +3 `complementBit` 2 = 7 +3 `complementBit` 3 = 11 +3 `complementBit` 32 = 4294967299 +3 `complementBit` 64 = 18446744073709551619 + +# +0 `testBit` 0 = False +0 `testBit` 1 = False +0 `testBit` 2 = False +0 `testBit` 3 = False +0 `testBit` 32 = False +0 `testBit` 64 = False + +1 `testBit` 0 = True +1 `testBit` 1 = False +1 `testBit` 2 = False +1 `testBit` 3 = False +1 `testBit` 32 = False +1 `testBit` 64 = False + +2 `testBit` 0 = False +2 `testBit` 1 = True +2 `testBit` 2 = False +2 `testBit` 3 = False +2 `testBit` 32 = False +2 `testBit` 64 = False + +3 `testBit` 0 = True +3 `testBit` 1 = True +3 `testBit` 2 = False +3 `testBit` 3 = False +3 `testBit` 32 = False +3 `testBit` 64 = False + +# +isSigned 0 = False +isSigned 1 = False +isSigned 2 = False +isSigned 3 = False +# diff --git a/testsuite/tests/numeric/should_run/numrun016.hs b/testsuite/tests/numeric/should_run/numrun016.hs new file mode 100644 index 0000000000..c45e322030 --- /dev/null +++ b/testsuite/tests/numeric/should_run/numrun016.hs @@ -0,0 +1,8 @@ +-- test for trac #8532 + +import Data.Complex + +main :: IO () +main = do + print $ acosh ((-1)::Complex Double) + print $ acosh ((-1)::Complex Float) diff --git a/testsuite/tests/numeric/should_run/numrun016.stdout b/testsuite/tests/numeric/should_run/numrun016.stdout new file mode 100644 index 0000000000..25676f77dc --- /dev/null +++ b/testsuite/tests/numeric/should_run/numrun016.stdout @@ -0,0 +1,2 @@ +0.0 :+ 3.141592653589793 +0.0 :+ 3.1415927
\ No newline at end of file diff --git a/testsuite/tests/overloadedlists/should_fail/overloadedlistsfail01.stderr b/testsuite/tests/overloadedlists/should_fail/overloadedlistsfail01.stderr index 0faaaec792..c0d371f7bd 100644 --- a/testsuite/tests/overloadedlists/should_fail/overloadedlistsfail01.stderr +++ b/testsuite/tests/overloadedlists/should_fail/overloadedlistsfail01.stderr @@ -8,7 +8,7 @@ overloadedlistsfail01.hs:5:8: error: instance Show Integer -- Defined in ‘GHC.Show’ instance Show a => Show (Maybe a) -- Defined in ‘GHC.Show’ ...plus 22 others - ...plus six instances involving out-of-scope types + ...plus 13 instances involving out-of-scope types (use -fprint-potential-instances to see them all) • In the expression: print [1] In an equation for ‘main’: main = print [1] @@ -19,7 +19,7 @@ overloadedlistsfail01.hs:5:14: error: Probable fix: use a type annotation to specify what ‘a0’ should be. These potential instances exist: instance GHC.Exts.IsList [a] -- Defined in ‘GHC.Exts’ - ...plus two instances involving out-of-scope types + ...plus three instances involving out-of-scope types (use -fprint-potential-instances to see them all) • In the first argument of ‘print’, namely ‘[1]’ In the expression: print [1] @@ -35,6 +35,7 @@ overloadedlistsfail01.hs:5:15: error: instance Num Double -- Defined in ‘GHC.Float’ instance Num Float -- Defined in ‘GHC.Float’ ...plus two others + ...plus one instance involving out-of-scope types (use -fprint-potential-instances to see them all) • In the expression: 1 In the first argument of ‘print’, namely ‘[1]’ diff --git a/testsuite/tests/overloadedrecflds/ghci/duplicaterecfldsghci01.stdout b/testsuite/tests/overloadedrecflds/ghci/duplicaterecfldsghci01.stdout index 3270089b9c..cfed45f6f1 100644 --- a/testsuite/tests/overloadedrecflds/ghci/duplicaterecfldsghci01.stdout +++ b/testsuite/tests/overloadedrecflds/ghci/duplicaterecfldsghci01.stdout @@ -6,21 +6,21 @@ data T a = MkT {Ghci2.foo :: Bool, ...} <interactive>:1:1: error: Ambiguous occurrence ‘foo’ - It could refer to either the field ‘foo’, - defined at <interactive>:3:16 - or the field ‘foo’, defined at <interactive>:4:18 + It could refer to + either the field ‘foo’, defined at <interactive>:3:16 + or the field ‘foo’, defined at <interactive>:4:18 <interactive>:9:1: error: Ambiguous occurrence ‘foo’ - It could refer to either the field ‘foo’, - defined at <interactive>:3:16 - or the field ‘foo’, defined at <interactive>:4:18 + It could refer to + either the field ‘foo’, defined at <interactive>:3:16 + or the field ‘foo’, defined at <interactive>:4:18 True <interactive>:1:1: error: Ambiguous occurrence ‘foo’ - It could refer to either the field ‘foo’, - defined at <interactive>:3:16 - or the field ‘foo’, defined at <interactive>:4:18 + It could refer to + either the field ‘foo’, defined at <interactive>:3:16 + or the field ‘foo’, defined at <interactive>:4:18 foo :: U -> Int 42 diff --git a/testsuite/tests/overloadedrecflds/should_fail/DuplicateExports.hs b/testsuite/tests/overloadedrecflds/should_fail/DuplicateExports.hs new file mode 100644 index 0000000000..e433e4aef2 --- /dev/null +++ b/testsuite/tests/overloadedrecflds/should_fail/DuplicateExports.hs @@ -0,0 +1,9 @@ +{-# LANGUAGE DuplicateRecordFields #-} +{-# OPTIONS_GHC -Werror=duplicate-exports #-} + +-- This should warn about the duplicate export of foo, but not the +-- exports of the two different bar fields. +module Export (T(foo, bar), foo, S(bar)) where + +data T = MkT { foo :: Int, bar :: Int } +data S = MkS { bar :: Int } diff --git a/testsuite/tests/overloadedrecflds/should_fail/DuplicateExports.stderr b/testsuite/tests/overloadedrecflds/should_fail/DuplicateExports.stderr new file mode 100644 index 0000000000..e2bdef49ab --- /dev/null +++ b/testsuite/tests/overloadedrecflds/should_fail/DuplicateExports.stderr @@ -0,0 +1,3 @@ + +DuplicateExports.hs:6:29: error: [-Wduplicate-exports (in -Wdefault), -Werror=duplicate-exports] + ‘foo’ is exported by ‘foo’ and ‘T(foo, bar)’ diff --git a/testsuite/tests/overloadedrecflds/should_fail/T14953.hs b/testsuite/tests/overloadedrecflds/should_fail/T14953.hs new file mode 100644 index 0000000000..3a0020b561 --- /dev/null +++ b/testsuite/tests/overloadedrecflds/should_fail/T14953.hs @@ -0,0 +1,4 @@ +{-# LANGUAGE DuplicateRecordFields #-} +module T14953 (module T14953_A, module T14953_B) where +import T14953_A +import T14953_B diff --git a/testsuite/tests/overloadedrecflds/should_fail/T14953.stderr b/testsuite/tests/overloadedrecflds/should_fail/T14953.stderr new file mode 100644 index 0000000000..dc2249750e --- /dev/null +++ b/testsuite/tests/overloadedrecflds/should_fail/T14953.stderr @@ -0,0 +1,30 @@ +[1 of 3] Compiling T14953_A ( T14953_A.hs, T14953_A.o ) +[2 of 3] Compiling T14953_B ( T14953_B.hs, T14953_B.o ) +[3 of 3] Compiling T14953 ( T14953.hs, T14953.o ) + +T14953.hs:2:33: error: + Conflicting exports for ‘R’: + ‘module T14953_A’ exports ‘T14953_A.R’ + imported from ‘T14953_A’ at T14953.hs:3:1-15 + (and originally defined at T14953_A.hs:3:1-23) + ‘module T14953_B’ exports ‘T14953_B.R’ + imported from ‘T14953_B’ at T14953.hs:4:1-15 + (and originally defined at T14953_B.hs:3:1-23) + +T14953.hs:2:33: error: + Conflicting exports for ‘R’: + ‘module T14953_A’ exports ‘T14953_A.R’ + imported from ‘T14953_A’ at T14953.hs:3:1-15 + (and originally defined at T14953_A.hs:3:10-23) + ‘module T14953_B’ exports ‘T14953_B.R’ + imported from ‘T14953_B’ at T14953.hs:4:1-15 + (and originally defined at T14953_B.hs:3:10-23) + +T14953.hs:2:33: error: + Conflicting exports for ‘unR’: + ‘module T14953_A’ exports ‘unR’ + imported from ‘T14953_A’ at T14953.hs:3:1-15 + (and originally defined at T14953_A.hs:3:13-15) + ‘module T14953_B’ exports ‘unR’ + imported from ‘T14953_B’ at T14953.hs:4:1-15 + (and originally defined at T14953_B.hs:3:13-15) diff --git a/testsuite/tests/overloadedrecflds/should_fail/T14953_A.hs b/testsuite/tests/overloadedrecflds/should_fail/T14953_A.hs new file mode 100644 index 0000000000..a3acd512ac --- /dev/null +++ b/testsuite/tests/overloadedrecflds/should_fail/T14953_A.hs @@ -0,0 +1,3 @@ +{-# LANGUAGE DuplicateRecordFields #-} +module T14953_A where +data R = R {unR :: Int} diff --git a/testsuite/tests/overloadedrecflds/should_fail/T14953_B.hs b/testsuite/tests/overloadedrecflds/should_fail/T14953_B.hs new file mode 100644 index 0000000000..4d4696b833 --- /dev/null +++ b/testsuite/tests/overloadedrecflds/should_fail/T14953_B.hs @@ -0,0 +1,3 @@ +{-# LANGUAGE DuplicateRecordFields #-} +module T14953_B where +data R = R {unR :: Int} diff --git a/testsuite/tests/overloadedrecflds/should_fail/all.T b/testsuite/tests/overloadedrecflds/should_fail/all.T index 5463be7006..92ff1f0015 100644 --- a/testsuite/tests/overloadedrecflds/should_fail/all.T +++ b/testsuite/tests/overloadedrecflds/should_fail/all.T @@ -29,3 +29,6 @@ test('hasfieldfail01', extra_files(['HasFieldFail01_A.hs']), multimod_compile_fail, ['hasfieldfail01', '']) test('hasfieldfail02', normal, compile_fail, ['']) test('hasfieldfail03', normal, compile_fail, ['']) +test('T14953', [extra_files(['T14953_A.hs', 'T14953_B.hs'])], + multimod_compile_fail, ['T14953', '']) +test('DuplicateExports', normal, compile_fail, ['']) diff --git a/testsuite/tests/overloadedrecflds/should_run/overloadedrecflds_generics.hs b/testsuite/tests/overloadedrecflds/should_run/overloadedrecflds_generics.hs index c2b4bd6120..56f93fb7af 100644 --- a/testsuite/tests/overloadedrecflds/should_run/overloadedrecflds_generics.hs +++ b/testsuite/tests/overloadedrecflds/should_run/overloadedrecflds_generics.hs @@ -17,14 +17,15 @@ import GHC.Generics import Data.Data import Data.Proxy +import Data.Kind -type family FirstSelector (f :: * -> *) :: Meta +type family FirstSelector (f :: Type -> Type) :: Meta type instance FirstSelector (M1 D x f) = FirstSelector f type instance FirstSelector (M1 C x f) = FirstSelector f type instance FirstSelector (a :*: b) = FirstSelector a type instance FirstSelector (M1 S s f) = s -data SelectorProxy (s :: Meta) (f :: * -> *) a = SelectorProxy +data SelectorProxy (s :: Meta) (f :: Type -> Type) a = SelectorProxy type SelectorProxy' (s :: Meta) = SelectorProxy s Proxy () -- Extract the first selector name using GHC.Generics diff --git a/testsuite/tests/overloadedrecflds/should_run/overloadedrecfldsrun07.hs b/testsuite/tests/overloadedrecflds/should_run/overloadedrecfldsrun07.hs index 25da616583..fdd81c213d 100644 --- a/testsuite/tests/overloadedrecflds/should_run/overloadedrecfldsrun07.hs +++ b/testsuite/tests/overloadedrecflds/should_run/overloadedrecfldsrun07.hs @@ -1,10 +1,10 @@ {-# LANGUAGE DataKinds + , PolyKinds , FlexibleContexts , FlexibleInstances , GADTs , MultiParamTypeClasses , OverloadedLabels - , PolyKinds , ScopedTypeVariables , TypeApplications , TypeOperators @@ -14,11 +14,12 @@ import GHC.OverloadedLabels import GHC.Records import GHC.TypeLits +import Data.Kind data Label (x :: Symbol) = Label data Labelled x a = Label x := a -data Rec :: [(k, *)] -> * where +data Rec :: forall k. [(k, Type)] -> Type where Nil :: Rec '[] (:>) :: Labelled x a -> Rec xs -> Rec ('(x, a) ': xs) infixr 5 :> diff --git a/testsuite/tests/package/T4806.hs b/testsuite/tests/package/T4806.hs new file mode 100644 index 0000000000..781cfef1ac --- /dev/null +++ b/testsuite/tests/package/T4806.hs @@ -0,0 +1 @@ +import Data.Map diff --git a/testsuite/tests/package/T4806.stderr b/testsuite/tests/package/T4806.stderr new file mode 100644 index 0000000000..99bde2ec0d --- /dev/null +++ b/testsuite/tests/package/T4806.stderr @@ -0,0 +1,6 @@ + +T4806.hs:1:1: error: + Could not load module ‘Data.Map’ + It is a member of the package ‘containers-0.6.0.1’ + which is ignored due to an -ignore-package flag + Use -v (or `:set -v` in ghci) to see a list of the files searched for. diff --git a/testsuite/tests/package/T4806a.hs b/testsuite/tests/package/T4806a.hs new file mode 100644 index 0000000000..781cfef1ac --- /dev/null +++ b/testsuite/tests/package/T4806a.hs @@ -0,0 +1 @@ +import Data.Map diff --git a/testsuite/tests/package/T4806a.stderr b/testsuite/tests/package/T4806a.stderr new file mode 100644 index 0000000000..3d768a64b6 --- /dev/null +++ b/testsuite/tests/package/T4806a.stderr @@ -0,0 +1,7 @@ + +T4806a.hs:1:1: error: + Could not load module ‘Data.Map’ + It is a member of the package ‘containers-0.6.0.1’ + which is unusable because the -ignore-package flag was used to ignore at least one of its dependencies: + deepseq-1.4.4.0 + Use -v (or `:set -v` in ghci) to see a list of the files searched for. diff --git a/testsuite/tests/package/all.T b/testsuite/tests/package/all.T index 129ae8540c..869abb1a7a 100644 --- a/testsuite/tests/package/all.T +++ b/testsuite/tests/package/all.T @@ -6,7 +6,7 @@ inc_ghc = '-package ghc ' hide_ghc = '-hide-package ghc ' test('package01', normal, compile, [hide_all + incr_containers]) -test('package01e', normal, compile_fail, [hide_all + incr_containers]) +test('package01e', normalise_version('containers'), compile_fail, [hide_all + incr_containers]) test('package02', normal, compile, [hide_all + inc_containers + incr_containers]) test('package03', normal, compile, [hide_all + incr_containers + inc_containers]) test('package04', normal, compile, [incr_containers]) @@ -17,3 +17,6 @@ test('package07e', normalise_version('ghc'), compile_fail, [incr_ghc + inc_ghc + test('package08e', normalise_version('ghc'), compile_fail, [incr_ghc + hide_ghc]) test('package09e', normal, compile_fail, ['-package "containers (Data.Map as M, Data.Set as M)"']) test('package10', normal, compile, ['-hide-all-packages -package "ghc (UniqFM as Prelude)" ']) + +test('T4806', normalise_version('containers'), compile_fail, ['-ignore-package containers']) +test('T4806a', normalise_version('containers'), compile_fail, ['-ignore-package deepseq']) diff --git a/testsuite/tests/package/package01e.stderr b/testsuite/tests/package/package01e.stderr index cfde9a7b28..3381a1bd42 100644 --- a/testsuite/tests/package/package01e.stderr +++ b/testsuite/tests/package/package01e.stderr @@ -1,10 +1,14 @@ package01e.hs:2:1: error: - Could not find module ‘Data.Map’ - It is a member of the hidden package ‘containers-0.5.10.2’. - Use -v to see a list of the files searched for. + Could not load module ‘Data.Map’ + It is a member of the hidden package ‘containers-0.6.0.1’. + You can run ‘:set -package containers’ to expose it. + (Note: this unloads all the modules in the current scope.) + Use -v (or `:set -v` in ghci) to see a list of the files searched for. package01e.hs:3:1: error: - Could not find module ‘Data.IntMap’ - It is a member of the hidden package ‘containers-0.5.10.2’. - Use -v to see a list of the files searched for. + Could not load module ‘Data.IntMap’ + It is a member of the hidden package ‘containers-0.6.0.1’. + You can run ‘:set -package containers’ to expose it. + (Note: this unloads all the modules in the current scope.) + Use -v (or `:set -v` in ghci) to see a list of the files searched for. diff --git a/testsuite/tests/package/package06e.stderr b/testsuite/tests/package/package06e.stderr index c634d2d46c..12d721223c 100644 --- a/testsuite/tests/package/package06e.stderr +++ b/testsuite/tests/package/package06e.stderr @@ -1,10 +1,14 @@ package06e.hs:2:1: error: - Could not find module ‘HsTypes’ - It is a member of the hidden package ‘ghc-8.1’. - Use -v to see a list of the files searched for. + Could not load module ‘HsTypes’ + It is a member of the hidden package ‘ghc-8.7’. + You can run ‘:set -package ghc’ to expose it. + (Note: this unloads all the modules in the current scope.) + Use -v (or `:set -v` in ghci) to see a list of the files searched for. package06e.hs:3:1: error: - Could not find module ‘UniqFM’ - It is a member of the hidden package ‘ghc-8.1’. - Use -v to see a list of the files searched for. + Could not load module ‘UniqFM’ + It is a member of the hidden package ‘ghc-8.7’. + You can run ‘:set -package ghc’ to expose it. + (Note: this unloads all the modules in the current scope.) + Use -v (or `:set -v` in ghci) to see a list of the files searched for. diff --git a/testsuite/tests/package/package07e.stderr b/testsuite/tests/package/package07e.stderr index a446a47247..2678972a78 100644 --- a/testsuite/tests/package/package07e.stderr +++ b/testsuite/tests/package/package07e.stderr @@ -1,16 +1,26 @@ package07e.hs:2:1: error: Could not find module ‘MyHsTypes’ - Use -v to see a list of the files searched for. + Perhaps you meant HsTypes (needs flag -package-key ghc-8.7) + Use -v (or `:set -v` in ghci) to see a list of the files searched for. package07e.hs:3:1: error: - Could not find module ‘HsTypes’ - Use -v to see a list of the files searched for. + Could not load module ‘HsTypes’ + It is a member of the hidden package ‘ghc-8.7’. + You can run ‘:set -package ghc’ to expose it. + (Note: this unloads all the modules in the current scope.) + Use -v (or `:set -v` in ghci) to see a list of the files searched for. package07e.hs:4:1: error: - Could not find module ‘HsUtils’ - Use -v to see a list of the files searched for. + Could not load module ‘HsUtils’ + It is a member of the hidden package ‘ghc-8.7’. + You can run ‘:set -package ghc’ to expose it. + (Note: this unloads all the modules in the current scope.) + Use -v (or `:set -v` in ghci) to see a list of the files searched for. package07e.hs:5:1: error: - Could not find module ‘UniqFM’ - Use -v to see a list of the files searched for. + Could not load module ‘UniqFM’ + It is a member of the hidden package ‘ghc-8.7’. + You can run ‘:set -package ghc’ to expose it. + (Note: this unloads all the modules in the current scope.) + Use -v (or `:set -v` in ghci) to see a list of the files searched for. diff --git a/testsuite/tests/package/package08e.stderr b/testsuite/tests/package/package08e.stderr index 3d8d2321b7..f02e9d6da3 100644 --- a/testsuite/tests/package/package08e.stderr +++ b/testsuite/tests/package/package08e.stderr @@ -1,16 +1,26 @@ package08e.hs:2:1: error: Could not find module ‘MyHsTypes’ - Use -v to see a list of the files searched for. + Perhaps you meant HsTypes (needs flag -package-key ghc-8.7) + Use -v (or `:set -v` in ghci) to see a list of the files searched for. package08e.hs:3:1: error: - Could not find module ‘HsTypes’ - Use -v to see a list of the files searched for. + Could not load module ‘HsTypes’ + It is a member of the hidden package ‘ghc-8.7’. + You can run ‘:set -package ghc’ to expose it. + (Note: this unloads all the modules in the current scope.) + Use -v (or `:set -v` in ghci) to see a list of the files searched for. package08e.hs:4:1: error: - Could not find module ‘HsUtils’ - Use -v to see a list of the files searched for. + Could not load module ‘HsUtils’ + It is a member of the hidden package ‘ghc-8.7’. + You can run ‘:set -package ghc’ to expose it. + (Note: this unloads all the modules in the current scope.) + Use -v (or `:set -v` in ghci) to see a list of the files searched for. package08e.hs:5:1: error: - Could not find module ‘UniqFM’ - Use -v to see a list of the files searched for. + Could not load module ‘UniqFM’ + It is a member of the hidden package ‘ghc-8.7’. + You can run ‘:set -package ghc’ to expose it. + (Note: this unloads all the modules in the current scope.) + Use -v (or `:set -v` in ghci) to see a list of the files searched for. diff --git a/testsuite/tests/parser/should_compile/BlockArguments.hs b/testsuite/tests/parser/should_compile/BlockArguments.hs new file mode 100644 index 0000000000..f74c09d97c --- /dev/null +++ b/testsuite/tests/parser/should_compile/BlockArguments.hs @@ -0,0 +1,25 @@ +{-# LANGUAGE BlockArguments #-} + +module BlockArguments where + +import Control.Monad + +foo :: IO () +foo = when True do + return () + +foo' :: IO () +foo' = do + forM [1 .. 10] \x -> + print x + + forM [1 .. 10] \x -> do + print x + print x + + return () + +foo'' :: IO () +foo'' = when + do True + do return () diff --git a/testsuite/tests/parser/should_compile/BlockArgumentsLambdaCase.hs b/testsuite/tests/parser/should_compile/BlockArgumentsLambdaCase.hs new file mode 100644 index 0000000000..8e336c28f4 --- /dev/null +++ b/testsuite/tests/parser/should_compile/BlockArgumentsLambdaCase.hs @@ -0,0 +1,13 @@ +{-# LANGUAGE BlockArguments, LambdaCase #-} + +module BlockArgumentsLambdaCase where + +import Control.Monad + +foo' :: IO () +foo' = do + forM [Just 3, Nothing] \case + Just 3 -> print 3 + _ -> print 5 + + return () diff --git a/testsuite/tests/parser/should_compile/DumpParsedAst.stderr b/testsuite/tests/parser/should_compile/DumpParsedAst.stderr index ad3680e578..231017322f 100644 --- a/testsuite/tests/parser/should_compile/DumpParsedAst.stderr +++ b/testsuite/tests/parser/should_compile/DumpParsedAst.stderr @@ -2,236 +2,240 @@ ==================== Parser AST ==================== ({ DumpParsedAst.hs:1:1 } - (HsModule - (Just - ({ DumpParsedAst.hs:3:8-20 }{ModuleName: DumpParsedAst})) - (Nothing) - [] - [ - ({ DumpParsedAst.hs:5:1-30 } - (TyClD - (DataDecl + (HsModule + (Just + ({ DumpParsedAst.hs:3:8-20 } + {ModuleName: DumpParsedAst})) + (Nothing) + [] + [({ DumpParsedAst.hs:5:1-30 } + (TyClD + (NoExt) + (DataDecl + (NoExt) ({ DumpParsedAst.hs:5:6-10 } - (Unqual {OccName: Peano})) - (HsQTvs - (PlaceHolder) - [] - (PlaceHolder)) - (Prefix) - (HsDataDefn - (DataType) + (Unqual + {OccName: Peano})) + (HsQTvs + (NoExt) + []) + (Prefix) + (HsDataDefn + (NoExt) + (DataType) ({ <no location info> } - []) - (Nothing) - (Nothing) - [ - ({ DumpParsedAst.hs:5:14-17 } - (ConDeclH98 + []) + (Nothing) + (Nothing) + [({ DumpParsedAst.hs:5:14-17 } + (ConDeclH98 + (NoExt) ({ DumpParsedAst.hs:5:14-17 } - (Unqual {OccName: Zero})) - (Nothing) - (Just - ({ <no location info> } - [])) - (PrefixCon - []) - (Nothing))), - ({ DumpParsedAst.hs:5:21-30 } - (ConDeclH98 + (Unqual + {OccName: Zero})) + ({ <no location info> } + (False)) + [] + (Nothing) + (PrefixCon + []) + (Nothing))) + ,({ DumpParsedAst.hs:5:21-30 } + (ConDeclH98 + (NoExt) ({ DumpParsedAst.hs:5:21-24 } - (Unqual {OccName: Succ})) - (Nothing) - (Just - ({ <no location info> } - [])) - (PrefixCon - [ - ({ DumpParsedAst.hs:5:26-30 } - (HsTyVar - (NotPromoted) + (Unqual + {OccName: Succ})) + ({ <no location info> } + (False)) + [] + (Nothing) + (PrefixCon + [({ DumpParsedAst.hs:5:26-30 } + (HsTyVar + (NoExt) + (NotPromoted) ({ DumpParsedAst.hs:5:26-30 } - (Unqual {OccName: Peano}))))]) - (Nothing)))] + (Unqual + {OccName: Peano}))))]) + (Nothing)))] ({ <no location info> } - [])) - (PlaceHolder) - (PlaceHolder)))), - ({ DumpParsedAst.hs:7:1-39 } - (TyClD - (FamDecl - (FamilyDecl - (ClosedTypeFamily - (Just - [ - ({ DumpParsedAst.hs:8:3-36 } - (TyFamEqn - ({ DumpParsedAst.hs:8:3-8 } - (Unqual {OccName: Length})) - (HsIB - (PlaceHolder) - [ - ({ DumpParsedAst.hs:8:10-17 } - (HsParTy + []))))) + ,({ DumpParsedAst.hs:7:1-39 } + (TyClD + (NoExt) + (FamDecl + (NoExt) + (FamilyDecl + (NoExt) + (ClosedTypeFamily + (Just + [({ DumpParsedAst.hs:8:3-36 } + (HsIB + (NoExt) + (FamEqn + (NoExt) + ({ DumpParsedAst.hs:8:3-8 } + (Unqual + {OccName: Length})) + [({ DumpParsedAst.hs:8:10-17 } + (HsParTy + (NoExt) ({ DumpParsedAst.hs:8:11-16 } - (HsAppsTy - [ - ({ DumpParsedAst.hs:8:11 } - (HsAppPrefix - ({ DumpParsedAst.hs:8:11 } - (HsTyVar - (NotPromoted) - ({ DumpParsedAst.hs:8:11 } - (Unqual {OccName: a})))))), - ({ DumpParsedAst.hs:8:13 } - (HsAppInfix - ({ DumpParsedAst.hs:8:13 } - (Exact {Name: ghc-prim:GHC.Types.:{(w) d}})))), - ({ DumpParsedAst.hs:8:15-16 } - (HsAppPrefix - ({ DumpParsedAst.hs:8:15-16 } - (HsTyVar - (NotPromoted) - ({ DumpParsedAst.hs:8:15-16 } - (Unqual {OccName: as}))))))]))))] - (PlaceHolder)) - (Prefix) - ({ DumpParsedAst.hs:8:21-36 } - (HsAppsTy - [ + (HsOpTy + (NoExt) + ({ DumpParsedAst.hs:8:11 } + (HsTyVar + (NoExt) + (NotPromoted) + ({ DumpParsedAst.hs:8:11 } + (Unqual + {OccName: a})))) + ({ DumpParsedAst.hs:8:13 } + (Exact + {Name: :})) + ({ DumpParsedAst.hs:8:15-16 } + (HsTyVar + (NoExt) + (NotPromoted) + ({ DumpParsedAst.hs:8:15-16 } + (Unqual + {OccName: as}))))))))] + (Prefix) + ({ DumpParsedAst.hs:8:21-36 } + (HsAppTy + (NoExt) ({ DumpParsedAst.hs:8:21-24 } - (HsAppPrefix + (HsTyVar + (NoExt) + (NotPromoted) ({ DumpParsedAst.hs:8:21-24 } - (HsTyVar - (NotPromoted) - ({ DumpParsedAst.hs:8:21-24 } - (Unqual {OccName: Succ})))))), + (Unqual + {OccName: Succ})))) ({ DumpParsedAst.hs:8:26-36 } - (HsAppPrefix - ({ DumpParsedAst.hs:8:26-36 } - (HsParTy - ({ DumpParsedAst.hs:8:27-35 } - (HsAppsTy - [ - ({ DumpParsedAst.hs:8:27-32 } - (HsAppPrefix - ({ DumpParsedAst.hs:8:27-32 } - (HsTyVar - (NotPromoted) - ({ DumpParsedAst.hs:8:27-32 } - (Unqual {OccName: Length})))))), - ({ DumpParsedAst.hs:8:34-35 } - (HsAppPrefix - ({ DumpParsedAst.hs:8:34-35 } - (HsTyVar - (NotPromoted) - ({ DumpParsedAst.hs:8:34-35 } - (Unqual {OccName: as}))))))]))))))])))), - ({ DumpParsedAst.hs:9:3-24 } - (TyFamEqn - ({ DumpParsedAst.hs:9:3-8 } - (Unqual {OccName: Length})) - (HsIB - (PlaceHolder) - [ - ({ DumpParsedAst.hs:9:10-12 } - (HsExplicitListTy - (Promoted) - (PlaceHolder) - []))] - (PlaceHolder)) - (Prefix) - ({ DumpParsedAst.hs:9:21-24 } - (HsAppsTy - [ + (HsParTy + (NoExt) + ({ DumpParsedAst.hs:8:27-35 } + (HsAppTy + (NoExt) + ({ DumpParsedAst.hs:8:27-32 } + (HsTyVar + (NoExt) + (NotPromoted) + ({ DumpParsedAst.hs:8:27-32 } + (Unqual + {OccName: Length})))) + ({ DumpParsedAst.hs:8:34-35 } + (HsTyVar + (NoExt) + (NotPromoted) + ({ DumpParsedAst.hs:8:34-35 } + (Unqual + {OccName: as}))))))))))))) + ,({ DumpParsedAst.hs:9:3-24 } + (HsIB + (NoExt) + (FamEqn + (NoExt) + ({ DumpParsedAst.hs:9:3-8 } + (Unqual + {OccName: Length})) + [({ DumpParsedAst.hs:9:10-12 } + (HsExplicitListTy + (NoExt) + (Promoted) + []))] + (Prefix) + ({ DumpParsedAst.hs:9:21-24 } + (HsTyVar + (NoExt) + (NotPromoted) ({ DumpParsedAst.hs:9:21-24 } - (HsAppPrefix - ({ DumpParsedAst.hs:9:21-24 } - (HsTyVar - (NotPromoted) - ({ DumpParsedAst.hs:9:21-24 } - (Unqual {OccName: Zero}))))))]))))])) + (Unqual + {OccName: Zero})))))))])) ({ DumpParsedAst.hs:7:13-18 } - (Unqual {OccName: Length})) - (HsQTvs - (PlaceHolder) - [ - ({ DumpParsedAst.hs:7:20-30 } - (KindedTyVar + (Unqual + {OccName: Length})) + (HsQTvs + (NoExt) + [({ DumpParsedAst.hs:7:20-30 } + (KindedTyVar + (NoExt) ({ DumpParsedAst.hs:7:21-22 } - (Unqual {OccName: as})) + (Unqual + {OccName: as})) ({ DumpParsedAst.hs:7:27-29 } - (HsAppsTy - [ - ({ DumpParsedAst.hs:7:27-29 } - (HsAppPrefix - ({ DumpParsedAst.hs:7:27-29 } - (HsListTy - ({ DumpParsedAst.hs:7:28 } - (HsAppsTy - [ - ({ DumpParsedAst.hs:7:28 } - (HsAppPrefix - ({ DumpParsedAst.hs:7:28 } - (HsTyVar - (NotPromoted) - ({ DumpParsedAst.hs:7:28 } - (Unqual {OccName: k}))))))]))))))]))))] - (PlaceHolder)) - (Prefix) + (HsListTy + (NoExt) + ({ DumpParsedAst.hs:7:28 } + (HsTyVar + (NoExt) + (NotPromoted) + ({ DumpParsedAst.hs:7:28 } + (Unqual + {OccName: k}))))))))]) + (Prefix) ({ DumpParsedAst.hs:7:32-39 } - (KindSig + (KindSig + (NoExt) ({ DumpParsedAst.hs:7:35-39 } - (HsAppsTy - [ - ({ DumpParsedAst.hs:7:35-39 } - (HsAppPrefix - ({ DumpParsedAst.hs:7:35-39 } - (HsTyVar - (NotPromoted) - ({ DumpParsedAst.hs:7:35-39 } - (Unqual {OccName: Peano}))))))])))) - (Nothing))))), - ({ DumpParsedAst.hs:11:1-23 } - (ValD - (FunBind + (HsTyVar + (NoExt) + (NotPromoted) + ({ DumpParsedAst.hs:7:35-39 } + (Unqual + {OccName: Peano})))))) + (Nothing))))) + ,({ DumpParsedAst.hs:11:1-23 } + (ValD + (NoExt) + (FunBind + (NoExt) ({ DumpParsedAst.hs:11:1-4 } - (Unqual {OccName: main})) - (MG + (Unqual + {OccName: main})) + (MG + (NoExt) ({ DumpParsedAst.hs:11:1-23 } - [ - ({ DumpParsedAst.hs:11:1-23 } - (Match - (FunRhs + [({ DumpParsedAst.hs:11:1-23 } + (Match + (NoExt) + (FunRhs ({ DumpParsedAst.hs:11:1-4 } - (Unqual {OccName: main})) - (Prefix) - (NoSrcStrict)) - [] - (Nothing) - (GRHSs - [ - ({ DumpParsedAst.hs:11:6-23 } - (GRHS - [] + (Unqual + {OccName: main})) + (Prefix) + (NoSrcStrict)) + [] + (GRHSs + (NoExt) + [({ DumpParsedAst.hs:11:6-23 } + (GRHS + (NoExt) + [] ({ DumpParsedAst.hs:11:8-23 } - (HsApp + (HsApp + (NoExt) ({ DumpParsedAst.hs:11:8-15 } - (HsVar + (HsVar + (NoExt) ({ DumpParsedAst.hs:11:8-15 } - (Unqual {OccName: putStrLn})))) + (Unqual + {OccName: putStrLn})))) ({ DumpParsedAst.hs:11:17-23 } - (HsLit - (HsString - (SourceText "\"hello\"") {FastString: "hello"})))))))] + (HsLit + (NoExt) + (HsString + (SourceText + "\"hello\"") + {FastString: "hello"})))))))] ({ <no location info> } - (EmptyLocalBinds)))))]) - [] - (PlaceHolder) - (FromSource)) - (WpHole) - (PlaceHolder) - [])))] - (Nothing) + (EmptyLocalBinds + (NoExt))))))]) + (FromSource)) + (WpHole) + [])))] + (Nothing) (Nothing))) diff --git a/testsuite/tests/parser/should_compile/DumpRenamedAst.hs b/testsuite/tests/parser/should_compile/DumpRenamedAst.hs index cb23ad5085..bf3e372461 100644 --- a/testsuite/tests/parser/should_compile/DumpRenamedAst.hs +++ b/testsuite/tests/parser/should_compile/DumpRenamedAst.hs @@ -1,4 +1,5 @@ -{-# LANGUAGE DataKinds, PolyKinds, TypeOperators, TypeFamilies #-} +{-# LANGUAGE DataKinds, GADTs, PolyKinds, RankNTypes, TypeOperators, + TypeFamilies, StarIsType #-} module DumpRenamedAst where @@ -8,4 +9,10 @@ type family Length (as :: [k]) :: Peano where Length (a : as) = Succ (Length as) Length '[] = Zero +data family Nat :: k -> k -> * +-- Ensure that the `k` in the type pattern and `k` in the kind signature have +-- the same binding site. +newtype instance Nat (a :: k -> *) :: (k -> *) -> * where + Nat :: (forall xx. f xx -> g xx) -> Nat f g + main = putStrLn "hello" diff --git a/testsuite/tests/parser/should_compile/DumpRenamedAst.stderr b/testsuite/tests/parser/should_compile/DumpRenamedAst.stderr index c873ee148b..2c1a0ec7df 100644 --- a/testsuite/tests/parser/should_compile/DumpRenamedAst.stderr +++ b/testsuite/tests/parser/should_compile/DumpRenamedAst.stderr @@ -1,193 +1,454 @@ ==================== Renamer ==================== -(HsGroup - (ValBindsOut - [ - ((,) - (NonRecursive) {Bag(Located (HsBind Name)): - [ - ({ DumpRenamedAst.hs:11:1-23 } - (FunBind - ({ DumpRenamedAst.hs:11:1-4 }{Name: main:DumpRenamedAst.main{v}}) - (MG - ({ DumpRenamedAst.hs:11:1-23 } - [ - ({ DumpRenamedAst.hs:11:1-23 } - (Match - (FunRhs - ({ DumpRenamedAst.hs:11:1-4 }{Name: main:DumpRenamedAst.main{v}}) - (Prefix) - (NoSrcStrict)) - [] - (Nothing) - (GRHSs - [ - ({ DumpRenamedAst.hs:11:6-23 } - (GRHS - [] - ({ DumpRenamedAst.hs:11:8-23 } - (HsApp - ({ DumpRenamedAst.hs:11:8-15 } - (HsVar - ({ DumpRenamedAst.hs:11:8-15 }{Name: base:System.IO.putStrLn{v}}))) - ({ DumpRenamedAst.hs:11:17-23 } - (HsLit - (HsString - (SourceText "\"hello\"") {FastString: "hello"})))))))] - ({ <no location info> } - (EmptyLocalBinds)))))]) - [] - (PlaceHolder) - (FromSource)) - (WpHole) {NameSet: - []} - []))]})] - []) - [] - [ - (TyClGroup - [ - ({ DumpRenamedAst.hs:5:1-30 } - (DataDecl - ({ DumpRenamedAst.hs:5:6-10 }{Name: main:DumpRenamedAst.Peano{tc}}) - (HsQTvs - [] - [] {NameSet: - []}) - (Prefix) - (HsDataDefn - (DataType) - ({ <no location info> } - []) - (Nothing) - (Nothing) - [ - ({ DumpRenamedAst.hs:5:14-17 } - (ConDeclH98 - ({ DumpRenamedAst.hs:5:14-17 }{Name: main:DumpRenamedAst.Zero{d}}) - (Nothing) - (Just - ({ <no location info> } - [])) - (PrefixCon - []) - (Nothing))), - ({ DumpRenamedAst.hs:5:21-30 } - (ConDeclH98 - ({ DumpRenamedAst.hs:5:21-24 }{Name: main:DumpRenamedAst.Succ{d}}) - (Nothing) - (Just - ({ <no location info> } - [])) - (PrefixCon - [ - ({ DumpRenamedAst.hs:5:26-30 } - (HsTyVar - (NotPromoted) - ({ DumpRenamedAst.hs:5:26-30 }{Name: main:DumpRenamedAst.Peano{tc}})))]) - (Nothing)))] - ({ <no location info> } - [])) - (True) {NameSet: - [{Name: main:DumpRenamedAst.Peano{tc}}]}))] - [] - []), - (TyClGroup - [ - ({ DumpRenamedAst.hs:7:1-39 } - (FamDecl - (FamilyDecl - (ClosedTypeFamily - (Just - [ - ({ DumpRenamedAst.hs:8:3-36 } - (TyFamEqn - ({ DumpRenamedAst.hs:8:3-8 }{Name: main:DumpRenamedAst.Length{tc}}) - (HsIB - [{Name: a{tv}},{Name: as{tv}}] - [ - ({ DumpRenamedAst.hs:8:10-17 } - (HsParTy - ({ DumpRenamedAst.hs:8:11-16 } - (HsOpTy - ({ DumpRenamedAst.hs:8:11 } - (HsTyVar - (NotPromoted) - ({ DumpRenamedAst.hs:8:11 }{Name: a{tv}}))) - ({ DumpRenamedAst.hs:8:13 }{Name: ghc-prim:GHC.Types.:{(w) d}}) - ({ DumpRenamedAst.hs:8:15-16 } - (HsTyVar - (NotPromoted) - ({ DumpRenamedAst.hs:8:15-16 }{Name: as{tv}})))))))] - (True)) - (Prefix) - ({ DumpRenamedAst.hs:8:21-36 } - (HsAppTy - ({ DumpRenamedAst.hs:8:21-24 } - (HsTyVar - (NotPromoted) - ({ DumpRenamedAst.hs:8:21-24 }{Name: main:DumpRenamedAst.Succ{d}}))) - ({ DumpRenamedAst.hs:8:26-36 } - (HsParTy - ({ DumpRenamedAst.hs:8:27-35 } - (HsAppTy - ({ DumpRenamedAst.hs:8:27-32 } - (HsTyVar - (NotPromoted) - ({ DumpRenamedAst.hs:8:27-32 }{Name: main:DumpRenamedAst.Length{tc}}))) - ({ DumpRenamedAst.hs:8:34-35 } - (HsTyVar - (NotPromoted) - ({ DumpRenamedAst.hs:8:34-35 }{Name: as{tv}}))))))))))), - ({ DumpRenamedAst.hs:9:3-24 } - (TyFamEqn - ({ DumpRenamedAst.hs:9:3-8 }{Name: main:DumpRenamedAst.Length{tc}}) - (HsIB - [] - [ - ({ DumpRenamedAst.hs:9:10-12 } - (HsExplicitListTy - (Promoted) - (PlaceHolder) - []))] - (True)) - (Prefix) - ({ DumpRenamedAst.hs:9:21-24 } - (HsTyVar - (NotPromoted) - ({ DumpRenamedAst.hs:9:21-24 }{Name: main:DumpRenamedAst.Zero{d}})))))])) - ({ DumpRenamedAst.hs:7:13-18 }{Name: main:DumpRenamedAst.Length{tc}}) - (HsQTvs - [{Name: k{tv}}] - [ - ({ DumpRenamedAst.hs:7:20-30 } - (KindedTyVar - ({ DumpRenamedAst.hs:7:21-22 }{Name: as{tv}}) - ({ DumpRenamedAst.hs:7:27-29 } - (HsListTy - ({ DumpRenamedAst.hs:7:28 } - (HsTyVar - (NotPromoted) - ({ DumpRenamedAst.hs:7:28 }{Name: k{tv}})))))))] {NameSet: - []}) - (Prefix) - ({ DumpRenamedAst.hs:7:32-39 } - (KindSig - ({ DumpRenamedAst.hs:7:35-39 } - (HsTyVar - (NotPromoted) - ({ DumpRenamedAst.hs:7:35-39 }{Name: main:DumpRenamedAst.Peano{tc}}))))) - (Nothing))))] - [] - [])] - [] - [] - [] - [] - [] - [] - [] - [] - []) +(Just + ((,,,) + (HsGroup + (NoExt) + (XValBindsLR + (NValBinds + [((,) + (NonRecursive) + {Bag(Located (HsBind Name)): + [({ DumpRenamedAst.hs:18:1-23 } + (FunBind + {NameSet: + []} + ({ DumpRenamedAst.hs:18:1-4 } + {Name: DumpRenamedAst.main}) + (MG + (NoExt) + ({ DumpRenamedAst.hs:18:1-23 } + [({ DumpRenamedAst.hs:18:1-23 } + (Match + (NoExt) + (FunRhs + ({ DumpRenamedAst.hs:18:1-4 } + {Name: DumpRenamedAst.main}) + (Prefix) + (NoSrcStrict)) + [] + (GRHSs + (NoExt) + [({ DumpRenamedAst.hs:18:6-23 } + (GRHS + (NoExt) + [] + ({ DumpRenamedAst.hs:18:8-23 } + (HsApp + (NoExt) + ({ DumpRenamedAst.hs:18:8-15 } + (HsVar + (NoExt) + ({ DumpRenamedAst.hs:18:8-15 } + {Name: System.IO.putStrLn}))) + ({ DumpRenamedAst.hs:18:17-23 } + (HsLit + (NoExt) + (HsString + (SourceText + "\"hello\"") + {FastString: "hello"})))))))] + ({ <no location info> } + (EmptyLocalBinds + (NoExt))))))]) + (FromSource)) + (WpHole) + []))]})] + [])) + [] + [(TyClGroup + (NoExt) + [({ DumpRenamedAst.hs:6:1-30 } + (DataDecl + (DataDeclRn + (True) + {NameSet: + [{Name: DumpRenamedAst.Peano}]}) + ({ DumpRenamedAst.hs:6:6-10 } + {Name: DumpRenamedAst.Peano}) + (HsQTvs + (HsQTvsRn + [] + {NameSet: + []}) + []) + (Prefix) + (HsDataDefn + (NoExt) + (DataType) + ({ <no location info> } + []) + (Nothing) + (Nothing) + [({ DumpRenamedAst.hs:6:14-17 } + (ConDeclH98 + (NoExt) + ({ DumpRenamedAst.hs:6:14-17 } + {Name: DumpRenamedAst.Zero}) + ({ <no location info> } + (False)) + [] + (Nothing) + (PrefixCon + []) + (Nothing))) + ,({ DumpRenamedAst.hs:6:21-30 } + (ConDeclH98 + (NoExt) + ({ DumpRenamedAst.hs:6:21-24 } + {Name: DumpRenamedAst.Succ}) + ({ <no location info> } + (False)) + [] + (Nothing) + (PrefixCon + [({ DumpRenamedAst.hs:6:26-30 } + (HsTyVar + (NoExt) + (NotPromoted) + ({ DumpRenamedAst.hs:6:26-30 } + {Name: DumpRenamedAst.Peano})))]) + (Nothing)))] + ({ <no location info> } + []))))] + [] + []) + ,(TyClGroup + (NoExt) + [({ DumpRenamedAst.hs:8:1-39 } + (FamDecl + (NoExt) + (FamilyDecl + (NoExt) + (ClosedTypeFamily + (Just + [({ DumpRenamedAst.hs:9:3-36 } + (HsIB + [{Name: a} + ,{Name: as}] + (FamEqn + (NoExt) + ({ DumpRenamedAst.hs:9:3-8 } + {Name: DumpRenamedAst.Length}) + [({ DumpRenamedAst.hs:9:10-17 } + (HsParTy + (NoExt) + ({ DumpRenamedAst.hs:9:11-16 } + (HsOpTy + (NoExt) + ({ DumpRenamedAst.hs:9:11 } + (HsTyVar + (NoExt) + (NotPromoted) + ({ DumpRenamedAst.hs:9:11 } + {Name: a}))) + ({ DumpRenamedAst.hs:9:13 } + {Name: :}) + ({ DumpRenamedAst.hs:9:15-16 } + (HsTyVar + (NoExt) + (NotPromoted) + ({ DumpRenamedAst.hs:9:15-16 } + {Name: as})))))))] + (Prefix) + ({ DumpRenamedAst.hs:9:21-36 } + (HsAppTy + (NoExt) + ({ DumpRenamedAst.hs:9:21-24 } + (HsTyVar + (NoExt) + (NotPromoted) + ({ DumpRenamedAst.hs:9:21-24 } + {Name: DumpRenamedAst.Succ}))) + ({ DumpRenamedAst.hs:9:26-36 } + (HsParTy + (NoExt) + ({ DumpRenamedAst.hs:9:27-35 } + (HsAppTy + (NoExt) + ({ DumpRenamedAst.hs:9:27-32 } + (HsTyVar + (NoExt) + (NotPromoted) + ({ DumpRenamedAst.hs:9:27-32 } + {Name: DumpRenamedAst.Length}))) + ({ DumpRenamedAst.hs:9:34-35 } + (HsTyVar + (NoExt) + (NotPromoted) + ({ DumpRenamedAst.hs:9:34-35 } + {Name: as})))))))))))) + ,({ DumpRenamedAst.hs:10:3-24 } + (HsIB + [] + (FamEqn + (NoExt) + ({ DumpRenamedAst.hs:10:3-8 } + {Name: DumpRenamedAst.Length}) + [({ DumpRenamedAst.hs:10:10-12 } + (HsExplicitListTy + (NoExt) + (Promoted) + []))] + (Prefix) + ({ DumpRenamedAst.hs:10:21-24 } + (HsTyVar + (NoExt) + (NotPromoted) + ({ DumpRenamedAst.hs:10:21-24 } + {Name: DumpRenamedAst.Zero}))))))])) + ({ DumpRenamedAst.hs:8:13-18 } + {Name: DumpRenamedAst.Length}) + (HsQTvs + (HsQTvsRn + [{Name: k}] + {NameSet: + []}) + [({ DumpRenamedAst.hs:8:20-30 } + (KindedTyVar + (NoExt) + ({ DumpRenamedAst.hs:8:21-22 } + {Name: as}) + ({ DumpRenamedAst.hs:8:27-29 } + (HsListTy + (NoExt) + ({ DumpRenamedAst.hs:8:28 } + (HsTyVar + (NoExt) + (NotPromoted) + ({ DumpRenamedAst.hs:8:28 } + {Name: k})))))))]) + (Prefix) + ({ DumpRenamedAst.hs:8:32-39 } + (KindSig + (NoExt) + ({ DumpRenamedAst.hs:8:35-39 } + (HsTyVar + (NoExt) + (NotPromoted) + ({ DumpRenamedAst.hs:8:35-39 } + {Name: DumpRenamedAst.Peano}))))) + (Nothing))))] + [] + []) + ,(TyClGroup + (NoExt) + [({ DumpRenamedAst.hs:12:1-30 } + (FamDecl + (NoExt) + (FamilyDecl + (NoExt) + (DataFamily) + ({ DumpRenamedAst.hs:12:13-15 } + {Name: DumpRenamedAst.Nat}) + (HsQTvs + (HsQTvsRn + [{Name: k}] + {NameSet: + []}) + []) + (Prefix) + ({ DumpRenamedAst.hs:12:17-30 } + (KindSig + (NoExt) + ({ DumpRenamedAst.hs:12:20-30 } + (HsFunTy + (NoExt) + ({ DumpRenamedAst.hs:12:20 } + (HsTyVar + (NoExt) + (NotPromoted) + ({ DumpRenamedAst.hs:12:20 } + {Name: k}))) + ({ DumpRenamedAst.hs:12:25-30 } + (HsFunTy + (NoExt) + ({ DumpRenamedAst.hs:12:25 } + (HsTyVar + (NoExt) + (NotPromoted) + ({ DumpRenamedAst.hs:12:25 } + {Name: k}))) + ({ DumpRenamedAst.hs:12:30 } + (HsStarTy + (NoExt) + (False))))))))) + (Nothing))))] + [] + [({ DumpRenamedAst.hs:(15,1)-(16,45) } + (DataFamInstD + (NoExt) + (DataFamInstDecl + (HsIB + [{Name: k} + ,{Name: a}] + (FamEqn + (NoExt) + ({ DumpRenamedAst.hs:15:18-20 } + {Name: DumpRenamedAst.Nat}) + [({ DumpRenamedAst.hs:15:22-34 } + (HsKindSig + (NoExt) + ({ DumpRenamedAst.hs:15:23 } + (HsTyVar + (NoExt) + (NotPromoted) + ({ DumpRenamedAst.hs:15:23 } + {Name: a}))) + ({ DumpRenamedAst.hs:15:28-33 } + (HsFunTy + (NoExt) + ({ DumpRenamedAst.hs:15:28 } + (HsTyVar + (NoExt) + (NotPromoted) + ({ DumpRenamedAst.hs:15:28 } + {Name: k}))) + ({ DumpRenamedAst.hs:15:33 } + (HsStarTy + (NoExt) + (False)))))))] + (Prefix) + (HsDataDefn + (NoExt) + (NewType) + ({ <no location info> } + []) + (Nothing) + (Just + ({ DumpRenamedAst.hs:15:39-51 } + (HsFunTy + (NoExt) + ({ DumpRenamedAst.hs:15:39-46 } + (HsParTy + (NoExt) + ({ DumpRenamedAst.hs:15:40-45 } + (HsFunTy + (NoExt) + ({ DumpRenamedAst.hs:15:40 } + (HsTyVar + (NoExt) + (NotPromoted) + ({ DumpRenamedAst.hs:15:40 } + {Name: k}))) + ({ DumpRenamedAst.hs:15:45 } + (HsStarTy + (NoExt) + (False))))))) + ({ DumpRenamedAst.hs:15:51 } + (HsStarTy + (NoExt) + (False)))))) + [({ DumpRenamedAst.hs:16:3-45 } + (ConDeclGADT + (NoExt) + [({ DumpRenamedAst.hs:16:3-5 } + {Name: DumpRenamedAst.Nat})] + ({ DumpRenamedAst.hs:16:10-45 } + (False)) + (HsQTvs + (HsQTvsRn + [{Name: f} + ,{Name: g}] + {NameSet: + []}) + []) + (Nothing) + (PrefixCon + [({ DumpRenamedAst.hs:16:10-34 } + (HsParTy + (NoExt) + ({ DumpRenamedAst.hs:16:11-33 } + (HsForAllTy + (NoExt) + [({ DumpRenamedAst.hs:16:18-19 } + (UserTyVar + (NoExt) + ({ DumpRenamedAst.hs:16:18-19 } + {Name: xx})))] + ({ DumpRenamedAst.hs:16:22-33 } + (HsFunTy + (NoExt) + ({ DumpRenamedAst.hs:16:22-25 } + (HsAppTy + (NoExt) + ({ DumpRenamedAst.hs:16:22 } + (HsTyVar + (NoExt) + (NotPromoted) + ({ DumpRenamedAst.hs:16:22 } + {Name: f}))) + ({ DumpRenamedAst.hs:16:24-25 } + (HsTyVar + (NoExt) + (NotPromoted) + ({ DumpRenamedAst.hs:16:24-25 } + {Name: xx}))))) + ({ DumpRenamedAst.hs:16:30-33 } + (HsAppTy + (NoExt) + ({ DumpRenamedAst.hs:16:30 } + (HsTyVar + (NoExt) + (NotPromoted) + ({ DumpRenamedAst.hs:16:30 } + {Name: g}))) + ({ DumpRenamedAst.hs:16:32-33 } + (HsTyVar + (NoExt) + (NotPromoted) + ({ DumpRenamedAst.hs:16:32-33 } + {Name: xx})))))))))))]) + ({ DumpRenamedAst.hs:16:39-45 } + (HsAppTy + (NoExt) + ({ DumpRenamedAst.hs:16:39-43 } + (HsAppTy + (NoExt) + ({ DumpRenamedAst.hs:16:39-41 } + (HsTyVar + (NoExt) + (NotPromoted) + ({ DumpRenamedAst.hs:16:39-41 } + {Name: DumpRenamedAst.Nat}))) + ({ DumpRenamedAst.hs:16:43 } + (HsTyVar + (NoExt) + (NotPromoted) + ({ DumpRenamedAst.hs:16:43 } + {Name: f}))))) + ({ DumpRenamedAst.hs:16:45 } + (HsTyVar + (NoExt) + (NotPromoted) + ({ DumpRenamedAst.hs:16:45 } + {Name: g}))))) + (Nothing)))] + ({ <no location info> } + [])))))))])] + [] + [] + [] + [] + [] + [] + [] + []) + [({ DumpRenamedAst.hs:4:8-21 } + (ImportDecl + (NoExt) + (NoSourceText) + ({ DumpRenamedAst.hs:4:8-21 } + {ModuleName: Prelude}) + (Nothing) + (False) + (False) + (False) + (True) + (Nothing) + (Nothing)))] + (Nothing) + (Nothing))) + diff --git a/testsuite/tests/parser/should_compile/DumpTypecheckedAst.stderr b/testsuite/tests/parser/should_compile/DumpTypecheckedAst.stderr index 663a7d7f2e..8e3e868fb9 100644 --- a/testsuite/tests/parser/should_compile/DumpTypecheckedAst.stderr +++ b/testsuite/tests/parser/should_compile/DumpTypecheckedAst.stderr @@ -1,279 +1,371 @@ ==================== Typechecker ==================== -{Bag(Located (HsBind Var)): -[ - ({ <no location info> } - (VarBind {Var: (main:DumpTypecheckedAst.$tcPeano{v} [lidx] :: ghc-prim:GHC.Types.TyCon{tc})} - ({ <no location info> } - (HsApp - ({ <no location info> } - (HsApp - ({ <no location info> } - (HsApp - ({ <no location info> } - (HsApp - ({ <no location info> } - (HsApp - ({ <no location info> } - (HsApp - ({ <no location info> } - (HsConLikeOut - ({abstract:ConLike}))) - ({ <no location info> } - (HsLit - {HsWord{64}Prim - (14073232900889011755) - (NoSourceText)})))) - ({ <no location info> } - (HsLit - {HsWord{64}Prim - (2739668351064589274) - (NoSourceText)})))) - ({ <no location info> } - (HsVar - ({ <no location info> }{Var: (main:DumpTypecheckedAst.$trModule{v} [lidx] :: ghc-prim:GHC.Types.Module{tc})}))))) - ({ <no location info> } - (HsPar - ({ <no location info> } - (HsApp - ({ <no location info> } - (HsConLikeOut - ({abstract:ConLike}))) - ({ <no location info> } - (HsLit - (HsStringPrim - (NoSourceText) "Peano"))))))))) - ({ <no location info> } - (HsLit - {HsInt{64}Prim - (0) - (SourceText "0")})))) - ({ <no location info> } - (HsVar - ({ <no location info> }{Var: (ghc-prim:GHC.Types.krep$*{v} [gid] :: ghc-prim:GHC.Types.KindRep{tc})}))))) - (False))), - ({ <no location info> } - (VarBind {Var: (main:DumpTypecheckedAst.$tc'Zero{v} [lidx] :: ghc-prim:GHC.Types.TyCon{tc})} - ({ <no location info> } - (HsApp - ({ <no location info> } - (HsApp - ({ <no location info> } - (HsApp - ({ <no location info> } - (HsApp - ({ <no location info> } - (HsApp - ({ <no location info> } - (HsApp - ({ <no location info> } - (HsConLikeOut - ({abstract:ConLike}))) - ({ <no location info> } - (HsLit - {HsWord{64}Prim - (13760111476013868540) - (NoSourceText)})))) - ({ <no location info> } - (HsLit - {HsWord{64}Prim - (12314848029315386153) - (NoSourceText)})))) - ({ <no location info> } - (HsVar - ({ <no location info> }{Var: (main:DumpTypecheckedAst.$trModule{v} [lidx] :: ghc-prim:GHC.Types.Module{tc})}))))) - ({ <no location info> } - (HsPar - ({ <no location info> } - (HsApp - ({ <no location info> } - (HsConLikeOut - ({abstract:ConLike}))) - ({ <no location info> } - (HsLit - (HsStringPrim - (NoSourceText) "'Zero"))))))))) - ({ <no location info> } - (HsLit - {HsInt{64}Prim - (0) - (SourceText "0")})))) - ({ <no location info> } - (HsVar - ({ <no location info> }{Var: ($krep{v} [lid] :: ghc-prim:GHC.Types.KindRep{tc})}))))) - (False))), - ({ <no location info> } - (VarBind {Var: (main:DumpTypecheckedAst.$tc'Succ{v} [lidx] :: ghc-prim:GHC.Types.TyCon{tc})} - ({ <no location info> } - (HsApp - ({ <no location info> } - (HsApp - ({ <no location info> } - (HsApp - ({ <no location info> } - (HsApp - ({ <no location info> } - (HsApp - ({ <no location info> } - (HsApp - ({ <no location info> } - (HsConLikeOut - ({abstract:ConLike}))) - ({ <no location info> } - (HsLit - {HsWord{64}Prim - (1143980031331647856) - (NoSourceText)})))) - ({ <no location info> } - (HsLit - {HsWord{64}Prim - (14802086722010293686) - (NoSourceText)})))) - ({ <no location info> } - (HsVar - ({ <no location info> }{Var: (main:DumpTypecheckedAst.$trModule{v} [lidx] :: ghc-prim:GHC.Types.Module{tc})}))))) - ({ <no location info> } - (HsPar - ({ <no location info> } - (HsApp - ({ <no location info> } - (HsConLikeOut - ({abstract:ConLike}))) - ({ <no location info> } - (HsLit - (HsStringPrim - (NoSourceText) "'Succ"))))))))) - ({ <no location info> } - (HsLit - {HsInt{64}Prim - (0) - (SourceText "0")})))) - ({ <no location info> } - (HsVar - ({ <no location info> }{Var: ($krep{v} [lid] :: ghc-prim:GHC.Types.KindRep{tc})}))))) - (False))), - ({ <no location info> } - (VarBind {Var: ($krep{v} [lid] :: ghc-prim:GHC.Types.KindRep{tc})} - ({ <no location info> } - (HsApp - ({ <no location info> } - (HsApp - ({ <no location info> } - (HsConLikeOut - ({abstract:ConLike}))) - ({ <no location info> } - (HsVar - ({ <no location info> }{Var: ($krep{v} [lid] :: ghc-prim:GHC.Types.KindRep{tc})}))))) - ({ <no location info> } - (HsVar - ({ <no location info> }{Var: ($krep{v} [lid] :: ghc-prim:GHC.Types.KindRep{tc})}))))) - (False))), - ({ <no location info> } - (VarBind {Var: ($krep{v} [lid] :: ghc-prim:GHC.Types.KindRep{tc})} - ({ <no location info> } - (HsApp - ({ <no location info> } - (HsApp - ({ <no location info> } - (HsConLikeOut - ({abstract:ConLike}))) - ({ <no location info> } - (HsVar - ({ <no location info> }{Var: (main:DumpTypecheckedAst.$tcPeano{v} [lidx] :: ghc-prim:GHC.Types.TyCon{tc})}))))) - ({ <no location info> } - (HsWrap - (WpTyApp - (TyConApp - ({abstract:TyCon}) - [])) - (HsConLikeOut - ({abstract:ConLike})))))) - (False))), - ({ <no location info> } - (VarBind {Var: (main:DumpTypecheckedAst.$trModule{v} [lidx] :: ghc-prim:GHC.Types.Module{tc})} - ({ <no location info> } - (HsApp - ({ <no location info> } - (HsApp - ({ <no location info> } - (HsConLikeOut - ({abstract:ConLike}))) - ({ <no location info> } - (HsPar - ({ <no location info> } - (HsApp - ({ <no location info> } - (HsConLikeOut - ({abstract:ConLike}))) - ({ <no location info> } - (HsLit - (HsStringPrim - (NoSourceText) "main"))))))))) - ({ <no location info> } - (HsPar - ({ <no location info> } - (HsApp - ({ <no location info> } - (HsConLikeOut - ({abstract:ConLike}))) - ({ <no location info> } - (HsLit - (HsStringPrim - (NoSourceText) "DumpTypecheckedAst"))))))))) - (False))), - ({ DumpTypecheckedAst.hs:11:1-23 } - (AbsBinds - [] - [] - [ - (ABE {Var: (main:DumpTypecheckedAst.main{v} [lid] :: ghc-prim:GHC.Types.IO{tc} - ())} {Var: (main{v} [lid] :: ghc-prim:GHC.Types.IO{tc} ())} - (WpHole) - (SpecPrags - []))] - [ - ({abstract:TcEvBinds})] {Bag(Located (HsBind Var)): - [ - ({ DumpTypecheckedAst.hs:11:1-23 } - (FunBind - ({ DumpTypecheckedAst.hs:11:1-4 }{Var: (main{v} [lid] :: ghc-prim:GHC.Types.IO{tc} ())}) - (MG - ({ DumpTypecheckedAst.hs:11:1-23 } - [ - ({ DumpTypecheckedAst.hs:11:1-23 } - (Match - (FunRhs - ({ DumpTypecheckedAst.hs:11:1-4 }{Name: main:DumpTypecheckedAst.main{v}}) - (Prefix) - (NoSrcStrict)) - [] - (Nothing) - (GRHSs - [ - ({ DumpTypecheckedAst.hs:11:6-23 } - (GRHS - [] - ({ DumpTypecheckedAst.hs:11:8-23 } - (HsApp - ({ DumpTypecheckedAst.hs:11:8-15 } - (HsVar - ({ <no location info> }{Var: (base:System.IO.putStrLn{v} [gid] :: base:GHC.Base.String{tc} - -> ghc-prim:GHC.Types.IO{tc} ())}))) - ({ DumpTypecheckedAst.hs:11:17-23 } - (HsLit - (HsString - (SourceText "\"hello\"") {FastString: "hello"})))))))] + +{Bag(Located (HsBind Var)): + [({ <no location info> } + (VarBind + (NoExt) + {Var: DumpTypecheckedAst.$tcPeano} + ({ <no location info> } + (HsApp + (NoExt) + ({ <no location info> } + (HsApp + (NoExt) + ({ <no location info> } + (HsApp + (NoExt) + ({ <no location info> } + (HsApp + (NoExt) + ({ <no location info> } + (HsApp + (NoExt) + ({ <no location info> } + (HsApp + (NoExt) + ({ <no location info> } + (HsConLikeOut + (NoExt) + ({abstract:ConLike}))) + ({ <no location info> } + (HsLit + (NoExt) + {HsWord{64}Prim (14073232900889011755) (NoSourceText)})))) + ({ <no location info> } + (HsLit + (NoExt) + {HsWord{64}Prim (2739668351064589274) (NoSourceText)})))) + ({ <no location info> } + (HsVar + (NoExt) + ({ <no location info> } + {Var: DumpTypecheckedAst.$trModule}))))) + ({ <no location info> } + (HsPar + (NoExt) + ({ <no location info> } + (HsApp + (NoExt) + ({ <no location info> } + (HsConLikeOut + (NoExt) + ({abstract:ConLike}))) + ({ <no location info> } + (HsLit + (NoExt) + (HsStringPrim + (NoSourceText) + "Peano"))))))))) + ({ <no location info> } + (HsLit + (NoExt) + {HsInt{64}Prim (0) (SourceText + "0")})))) + ({ <no location info> } + (HsVar + (NoExt) + ({ <no location info> } + {Var: GHC.Types.krep$*}))))) + (False))) + ,({ <no location info> } + (VarBind + (NoExt) + {Var: DumpTypecheckedAst.$tc'Zero} + ({ <no location info> } + (HsApp + (NoExt) + ({ <no location info> } + (HsApp + (NoExt) + ({ <no location info> } + (HsApp + (NoExt) + ({ <no location info> } + (HsApp + (NoExt) + ({ <no location info> } + (HsApp + (NoExt) + ({ <no location info> } + (HsApp + (NoExt) + ({ <no location info> } + (HsConLikeOut + (NoExt) + ({abstract:ConLike}))) + ({ <no location info> } + (HsLit + (NoExt) + {HsWord{64}Prim (13760111476013868540) (NoSourceText)})))) + ({ <no location info> } + (HsLit + (NoExt) + {HsWord{64}Prim (12314848029315386153) (NoSourceText)})))) + ({ <no location info> } + (HsVar + (NoExt) + ({ <no location info> } + {Var: DumpTypecheckedAst.$trModule}))))) + ({ <no location info> } + (HsPar + (NoExt) ({ <no location info> } - (EmptyLocalBinds)))))]) - [] - (TyConApp - ({abstract:TyCon}) - [ - (TyConApp - ({abstract:TyCon}) - [])]) - (FromSource)) - (WpHole) {NameSet: - []} - []))]}))]} + (HsApp + (NoExt) + ({ <no location info> } + (HsConLikeOut + (NoExt) + ({abstract:ConLike}))) + ({ <no location info> } + (HsLit + (NoExt) + (HsStringPrim + (NoSourceText) + "'Zero"))))))))) + ({ <no location info> } + (HsLit + (NoExt) + {HsInt{64}Prim (0) (SourceText + "0")})))) + ({ <no location info> } + (HsVar + (NoExt) + ({ <no location info> } + {Var: $krep}))))) + (False))) + ,({ <no location info> } + (VarBind + (NoExt) + {Var: DumpTypecheckedAst.$tc'Succ} + ({ <no location info> } + (HsApp + (NoExt) + ({ <no location info> } + (HsApp + (NoExt) + ({ <no location info> } + (HsApp + (NoExt) + ({ <no location info> } + (HsApp + (NoExt) + ({ <no location info> } + (HsApp + (NoExt) + ({ <no location info> } + (HsApp + (NoExt) + ({ <no location info> } + (HsConLikeOut + (NoExt) + ({abstract:ConLike}))) + ({ <no location info> } + (HsLit + (NoExt) + {HsWord{64}Prim (1143980031331647856) (NoSourceText)})))) + ({ <no location info> } + (HsLit + (NoExt) + {HsWord{64}Prim (14802086722010293686) (NoSourceText)})))) + ({ <no location info> } + (HsVar + (NoExt) + ({ <no location info> } + {Var: DumpTypecheckedAst.$trModule}))))) + ({ <no location info> } + (HsPar + (NoExt) + ({ <no location info> } + (HsApp + (NoExt) + ({ <no location info> } + (HsConLikeOut + (NoExt) + ({abstract:ConLike}))) + ({ <no location info> } + (HsLit + (NoExt) + (HsStringPrim + (NoSourceText) + "'Succ"))))))))) + ({ <no location info> } + (HsLit + (NoExt) + {HsInt{64}Prim (0) (SourceText + "0")})))) + ({ <no location info> } + (HsVar + (NoExt) + ({ <no location info> } + {Var: $krep}))))) + (False))) + ,({ <no location info> } + (VarBind + (NoExt) + {Var: $krep} + ({ <no location info> } + (HsApp + (NoExt) + ({ <no location info> } + (HsApp + (NoExt) + ({ <no location info> } + (HsConLikeOut + (NoExt) + ({abstract:ConLike}))) + ({ <no location info> } + (HsVar + (NoExt) + ({ <no location info> } + {Var: $krep}))))) + ({ <no location info> } + (HsVar + (NoExt) + ({ <no location info> } + {Var: $krep}))))) + (False))) + ,({ <no location info> } + (VarBind + (NoExt) + {Var: $krep} + ({ <no location info> } + (HsApp + (NoExt) + ({ <no location info> } + (HsApp + (NoExt) + ({ <no location info> } + (HsConLikeOut + (NoExt) + ({abstract:ConLike}))) + ({ <no location info> } + (HsVar + (NoExt) + ({ <no location info> } + {Var: DumpTypecheckedAst.$tcPeano}))))) + ({ <no location info> } + (HsWrap + (NoExt) + (WpTyApp + (TyConApp + ({abstract:TyCon}) + [])) + (HsConLikeOut + (NoExt) + ({abstract:ConLike})))))) + (False))) + ,({ <no location info> } + (VarBind + (NoExt) + {Var: DumpTypecheckedAst.$trModule} + ({ <no location info> } + (HsApp + (NoExt) + ({ <no location info> } + (HsApp + (NoExt) + ({ <no location info> } + (HsConLikeOut + (NoExt) + ({abstract:ConLike}))) + ({ <no location info> } + (HsPar + (NoExt) + ({ <no location info> } + (HsApp + (NoExt) + ({ <no location info> } + (HsConLikeOut + (NoExt) + ({abstract:ConLike}))) + ({ <no location info> } + (HsLit + (NoExt) + (HsStringPrim + (NoSourceText) + "main"))))))))) + ({ <no location info> } + (HsPar + (NoExt) + ({ <no location info> } + (HsApp + (NoExt) + ({ <no location info> } + (HsConLikeOut + (NoExt) + ({abstract:ConLike}))) + ({ <no location info> } + (HsLit + (NoExt) + (HsStringPrim + (NoSourceText) + "DumpTypecheckedAst"))))))))) + (False))) + ,({ DumpTypecheckedAst.hs:11:1-23 } + (AbsBinds + (NoExt) + [] + [] + [(ABE + (NoExt) + {Var: main} + {Var: main} + (WpHole) + (SpecPrags + []))] + [({abstract:TcEvBinds})] + {Bag(Located (HsBind Var)): + [({ DumpTypecheckedAst.hs:11:1-23 } + (FunBind + {NameSet: + []} + ({ DumpTypecheckedAst.hs:11:1-4 } + {Var: main}) + (MG + (MatchGroupTc + [] + (TyConApp + ({abstract:TyCon}) + [(TyConApp + ({abstract:TyCon}) + [])])) + ({ DumpTypecheckedAst.hs:11:1-23 } + [({ DumpTypecheckedAst.hs:11:1-23 } + (Match + (NoExt) + (FunRhs + ({ DumpTypecheckedAst.hs:11:1-4 } + {Name: main}) + (Prefix) + (NoSrcStrict)) + [] + (GRHSs + (NoExt) + [({ DumpTypecheckedAst.hs:11:6-23 } + (GRHS + (NoExt) + [] + ({ DumpTypecheckedAst.hs:11:8-23 } + (HsApp + (NoExt) + ({ DumpTypecheckedAst.hs:11:8-15 } + (HsVar + (NoExt) + ({ <no location info> } + {Var: putStrLn}))) + ({ DumpTypecheckedAst.hs:11:17-23 } + (HsLit + (NoExt) + (HsString + (SourceText + "\"hello\"") + {FastString: "hello"})))))))] + ({ <no location info> } + (EmptyLocalBinds + (NoExt))))))]) + (FromSource)) + (WpHole) + []))]} + (False)))]} diff --git a/testsuite/tests/parser/should_compile/NoBlockArguments.hs b/testsuite/tests/parser/should_compile/NoBlockArguments.hs new file mode 100644 index 0000000000..169a460203 --- /dev/null +++ b/testsuite/tests/parser/should_compile/NoBlockArguments.hs @@ -0,0 +1,8 @@ +module NoBlockArguments where + +-- Make sure things parse normally +f :: a -> a +f = id + +foo :: [Int] +foo = f [x | x <- [1 .. 10]] diff --git a/testsuite/tests/parser/should_compile/T10379.hs b/testsuite/tests/parser/should_compile/T10379.hs index 1eb5f96382..eb231c4415 100644 --- a/testsuite/tests/parser/should_compile/T10379.hs +++ b/testsuite/tests/parser/should_compile/T10379.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE KindSignatures, GADTs, DataKinds, TypeOperators #-} +{-# LANGUAGE KindSignatures, GADTs, DataKinds #-} module Foo where data Foo1 :: [*] -> * where diff --git a/testsuite/tests/parser/should_compile/T10855.hs b/testsuite/tests/parser/should_compile/T10855.hs new file mode 100644 index 0000000000..cc66f5d4b3 --- /dev/null +++ b/testsuite/tests/parser/should_compile/T10855.hs @@ -0,0 +1,5 @@ +module T10855 where + +bool :: Int +bool = - case 3 > 5 of False -> 0; True -> (-1) +main = print (- do 4) diff --git a/testsuite/tests/parser/should_compile/T13986.hs b/testsuite/tests/parser/should_compile/T13986.hs new file mode 100644 index 0000000000..b1b4882a35 --- /dev/null +++ b/testsuite/tests/parser/should_compile/T13986.hs @@ -0,0 +1,5 @@ +{-# LANGUAGE TypeApplications #-} + +module T13986 where + +foo x₁@True = 10 diff --git a/testsuite/tests/parser/should_compile/T14189.hs b/testsuite/tests/parser/should_compile/T14189.hs new file mode 100644 index 0000000000..c26ebd7dee --- /dev/null +++ b/testsuite/tests/parser/should_compile/T14189.hs @@ -0,0 +1,6 @@ +module T14189 + ( + MyType (f,NT) + ) where + +data MyType = MT Int | NT | F { f :: Int } diff --git a/testsuite/tests/parser/should_compile/T14189.stderr b/testsuite/tests/parser/should_compile/T14189.stderr new file mode 100644 index 0000000000..e5aff5bf88 --- /dev/null +++ b/testsuite/tests/parser/should_compile/T14189.stderr @@ -0,0 +1,148 @@ + +==================== Renamer ==================== + +(Just + ((,,,) + (HsGroup + (NoExt) + (XValBindsLR + (NValBinds + [] + [])) + [] + [(TyClGroup + (NoExt) + [({ T14189.hs:6:1-42 } + (DataDecl + (DataDeclRn + (True) + {NameSet: + [{Name: GHC.Types.Int}]}) + ({ T14189.hs:6:6-11 } + {Name: T14189.MyType}) + (HsQTvs + (HsQTvsRn + [] + {NameSet: + []}) + []) + (Prefix) + (HsDataDefn + (NoExt) + (DataType) + ({ <no location info> } + []) + (Nothing) + (Nothing) + [({ T14189.hs:6:15-20 } + (ConDeclH98 + (NoExt) + ({ T14189.hs:6:15-16 } + {Name: T14189.MT}) + ({ <no location info> } + (False)) + [] + (Nothing) + (PrefixCon + [({ T14189.hs:6:18-20 } + (HsTyVar + (NoExt) + (NotPromoted) + ({ T14189.hs:6:18-20 } + {Name: GHC.Types.Int})))]) + (Nothing))) + ,({ T14189.hs:6:24-25 } + (ConDeclH98 + (NoExt) + ({ T14189.hs:6:24-25 } + {Name: T14189.NT}) + ({ <no location info> } + (False)) + [] + (Nothing) + (PrefixCon + []) + (Nothing))) + ,({ T14189.hs:6:29-42 } + (ConDeclH98 + (NoExt) + ({ T14189.hs:6:29 } + {Name: T14189.F}) + ({ <no location info> } + (False)) + [] + (Nothing) + (RecCon + ({ T14189.hs:6:31-42 } + [({ T14189.hs:6:33-40 } + (ConDeclField + (NoExt) + [({ T14189.hs:6:33 } + (FieldOcc + {Name: T14189.f} + ({ T14189.hs:6:33 } + (Unqual + {OccName: f}))))] + ({ T14189.hs:6:38-40 } + (HsTyVar + (NoExt) + (NotPromoted) + ({ T14189.hs:6:38-40 } + {Name: GHC.Types.Int}))) + (Nothing)))])) + (Nothing)))] + ({ <no location info> } + []))))] + [] + [])] + [] + [] + [] + [] + [] + [] + [] + []) + [({ T14189.hs:1:8-13 } + (ImportDecl + (NoExt) + (NoSourceText) + ({ T14189.hs:1:8-13 } + {ModuleName: Prelude}) + (Nothing) + (False) + (False) + (False) + (True) + (Nothing) + (Nothing)))] + (Just + [((,) + ({ T14189.hs:3:3-15 } + (IEThingWith + (NoExt) + ({ T14189.hs:3:3-8 } + (IEName + ({ T14189.hs:3:3-8 } + {Name: T14189.MyType}))) + (NoIEWildcard) + [({ T14189.hs:3:13-14 } + (IEName + ({ T14189.hs:3:13-14 } + {Name: T14189.NT})))] + [({ T14189.hs:3:11 } + (FieldLabel + {FastString: "f"} + (False) + {Name: T14189.f}))])) + [(AvailTC + {Name: T14189.MyType} + [{Name: T14189.MyType} + ,{Name: T14189.NT}] + [(FieldLabel + {FastString: "f"} + (False) + {Name: T14189.f})])])]) + (Nothing))) + + diff --git a/testsuite/tests/parser/should_compile/T15139.hs b/testsuite/tests/parser/should_compile/T15139.hs new file mode 100644 index 0000000000..9f98bb1319 --- /dev/null +++ b/testsuite/tests/parser/should_compile/T15139.hs @@ -0,0 +1,13 @@ +{-# LANGUAGE EmptyCase #-} +{-# LANGUAGE TypeOperators #-} +module T15139 where + +import Data.Type.Equality + +can'tHappen :: Int :~: Bool +can'tHappen = undefined + +f1, f2, g :: Bool -> Bool +f1 True = case can'tHappen of {} +f2 True = case can'tHappen of +g True = case () of () -> True diff --git a/testsuite/tests/parser/should_compile/T15139.stderr b/testsuite/tests/parser/should_compile/T15139.stderr new file mode 100644 index 0000000000..010bd7440c --- /dev/null +++ b/testsuite/tests/parser/should_compile/T15139.stderr @@ -0,0 +1,21 @@ + +T15139.hs:11:1: warning: [-Wincomplete-patterns (in -Wextra)] + Pattern match(es) are non-exhaustive + In an equation for ‘f1’: Patterns not matched: False + | +11 | f1 True = case can'tHappen of {} + | ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ + +T15139.hs:12:1: warning: [-Wincomplete-patterns (in -Wextra)] + Pattern match(es) are non-exhaustive + In an equation for ‘f2’: Patterns not matched: False + | +12 | f2 True = case can'tHappen of + | ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ + +T15139.hs:13:1: warning: [-Wincomplete-patterns (in -Wextra)] + Pattern match(es) are non-exhaustive + In an equation for ‘g’: Patterns not matched: False + | +13 | g True = case () of () -> True + | ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ diff --git a/testsuite/tests/parser/should_compile/T15279.hs b/testsuite/tests/parser/should_compile/T15279.hs new file mode 100644 index 0000000000..b80bd32b54 --- /dev/null +++ b/testsuite/tests/parser/should_compile/T15279.hs @@ -0,0 +1,7 @@ +{-# LANGUAGE CPP #-} +{-# OPTIONS_GHC -ddump-parsed-ast #-} +module T15279 where + +foo :: Char -> Char +#include "T15279.hs-incl" +foo _ = 'a' diff --git a/testsuite/tests/parser/should_compile/T15279.hs-incl b/testsuite/tests/parser/should_compile/T15279.hs-incl new file mode 100644 index 0000000000..d6385f28e3 --- /dev/null +++ b/testsuite/tests/parser/should_compile/T15279.hs-incl @@ -0,0 +1,2 @@ +foo 'a' = 'b' +foo 'b' = 'c' diff --git a/testsuite/tests/parser/should_compile/T15279.stderr b/testsuite/tests/parser/should_compile/T15279.stderr new file mode 100644 index 0000000000..ff215a763d --- /dev/null +++ b/testsuite/tests/parser/should_compile/T15279.stderr @@ -0,0 +1,3 @@ +(MG +(NoExt) +({ <combineSrcSpans: files differ> } diff --git a/testsuite/tests/parser/should_compile/T15323.hs b/testsuite/tests/parser/should_compile/T15323.hs new file mode 100644 index 0000000000..ffc8ad85f0 --- /dev/null +++ b/testsuite/tests/parser/should_compile/T15323.hs @@ -0,0 +1,6 @@ +{-# LANGUAGE GADTs #-} +{-# LANGUAGE RankNTypes #-} +module T15323 where + +data MaybeDefault v where + TestParens :: (forall v . (Eq v) => MaybeDefault v) diff --git a/testsuite/tests/parser/should_compile/T15323.stderr b/testsuite/tests/parser/should_compile/T15323.stderr new file mode 100644 index 0000000000..93b254bf32 --- /dev/null +++ b/testsuite/tests/parser/should_compile/T15323.stderr @@ -0,0 +1,96 @@ + +==================== Parser AST ==================== + +({ T15323.hs:1:1 } + (HsModule + (Just + ({ T15323.hs:3:8-13 } + {ModuleName: T15323})) + (Nothing) + [] + [({ T15323.hs:(5,1)-(6,56) } + (TyClD + (NoExt) + (DataDecl + (NoExt) + ({ T15323.hs:5:6-17 } + (Unqual + {OccName: MaybeDefault})) + (HsQTvs + (NoExt) + [({ T15323.hs:5:19 } + (UserTyVar + (NoExt) + ({ T15323.hs:5:19 } + (Unqual + {OccName: v}))))]) + (Prefix) + (HsDataDefn + (NoExt) + (DataType) + ({ <no location info> } + []) + (Nothing) + (Nothing) + [({ T15323.hs:6:5-56 } + (ConDeclGADT + (NoExt) + [({ T15323.hs:6:5-14 } + (Unqual + {OccName: TestParens}))] + ({ T15323.hs:6:21-55 } + (True)) + (HsQTvs + (NoExt) + [({ T15323.hs:6:28 } + (UserTyVar + (NoExt) + ({ T15323.hs:6:28 } + (Unqual + {OccName: v}))))]) + (Just + ({ T15323.hs:6:32-37 } + [({ T15323.hs:6:32-37 } + (HsParTy + (NoExt) + ({ T15323.hs:6:33-36 } + (HsAppTy + (NoExt) + ({ T15323.hs:6:33-34 } + (HsTyVar + (NoExt) + (NotPromoted) + ({ T15323.hs:6:33-34 } + (Unqual + {OccName: Eq})))) + ({ T15323.hs:6:36 } + (HsTyVar + (NoExt) + (NotPromoted) + ({ T15323.hs:6:36 } + (Unqual + {OccName: v}))))))))])) + (PrefixCon + []) + ({ T15323.hs:6:42-55 } + (HsAppTy + (NoExt) + ({ T15323.hs:6:42-53 } + (HsTyVar + (NoExt) + (NotPromoted) + ({ T15323.hs:6:42-53 } + (Unqual + {OccName: MaybeDefault})))) + ({ T15323.hs:6:55 } + (HsTyVar + (NoExt) + (NotPromoted) + ({ T15323.hs:6:55 } + (Unqual + {OccName: v})))))) + (Nothing)))] + ({ <no location info> } + [])))))] + (Nothing) + (Nothing))) diff --git a/testsuite/tests/parser/should_compile/T8258.hs b/testsuite/tests/parser/should_compile/T8258.hs new file mode 100644 index 0000000000..18d6483973 --- /dev/null +++ b/testsuite/tests/parser/should_compile/T8258.hs @@ -0,0 +1,5 @@ +{-# LANGUAGE GADTs #-} + +module T8258 where + +data T where diff --git a/testsuite/tests/parser/should_compile/all.T b/testsuite/tests/parser/should_compile/all.T index a9d6830701..d949f2b42e 100644 --- a/testsuite/tests/parser/should_compile/all.T +++ b/testsuite/tests/parser/should_compile/all.T @@ -41,7 +41,7 @@ test('read025', normal, compile, ['']) test('read026', normal, compile, ['']) test('read027', normal, compile, ['']) test('read028', normal, compile, ['']) -test('read029', expect_broken_for(10181, ['optasm', 'optllvm']), compile, ['']) +test('read029', normal, compile, ['']) test('read030', normal, compile, ['']) test('read031', normal, compile, ['']) test('read032', normal, compile, ['']) @@ -85,6 +85,9 @@ test('T2245', normal, compile, ['-fwarn-type-defaults']) test('T3303', [], multimod_compile, ['T3303', '-v0']) test('T3741', normal, compile, ['']) test('DoAndIfThenElse', normal, compile, ['']) +test('BlockArguments', normal, compile, ['']) +test('BlockArgumentsLambdaCase', normal, compile, ['']) +test('NoBlockArguments', normal, compile, ['']) test('NondecreasingIndentation', normal, compile, ['']) test('mc15', normal, compile, ['']) test('mc16', normal, compile, ['']) @@ -97,6 +100,7 @@ test('T7118', normal, compile, ['']) test('T7776', normal, compile, ['']) test('RdrNoStaticPointers01', [], compile, ['']) test('T5682', normal, compile, ['']) +test('T8258', normal, compile, ['']) test('T9723a', normal, compile, ['']) test('T9723b', normal, compile, ['']) test('T10188', normal, compile, ['']) @@ -108,3 +112,21 @@ test('DumpParsedAst', normal, compile, ['-dsuppress-uniques -ddump-parsed-a test('DumpRenamedAst', normal, compile, ['-dsuppress-uniques -ddump-rn-ast']) test('DumpTypecheckedAst', normal, compile, ['-dsuppress-uniques -ddump-tc-ast']) test('T13747', normal, compile, ['']) +test('T14189', normal, compile, ['-dsuppress-uniques -ddump-rn-ast']) +test('T13986', normal, compile, ['']) +test('T10855', normal, compile, ['']) +test('T15139', normal, compile, ['-Wincomplete-patterns -fdiagnostics-show-caret']) +test('T15323', normal, compile, ['-dsuppress-uniques -ddump-parsed-ast']) + +def only_MG_loc(x): + """ + Only compares the location embedded inside the MatchGroup, which has the form + (MG + (NoExt) + ({ <location> + """ + ls = x.split("\n") + mgLocs = (loc.strip() for (mg,loc) in zip(ls,ls[2:]) + if mg.strip().startswith("(MG")) + return '\n'.join(mgLocs) +test('T15279', normalise_errmsg_fun(only_MG_loc), compile, ['']) diff --git a/testsuite/tests/parser/should_fail/InfixAppPatErr.hs b/testsuite/tests/parser/should_fail/InfixAppPatErr.hs new file mode 100644 index 0000000000..5a56f711eb --- /dev/null +++ b/testsuite/tests/parser/should_fail/InfixAppPatErr.hs @@ -0,0 +1,5 @@ +main = do + f $ do + a <- return 3 + c <- do + return 5 diff --git a/testsuite/tests/parser/should_fail/InfixAppPatErr.stderr b/testsuite/tests/parser/should_fail/InfixAppPatErr.stderr new file mode 100644 index 0000000000..69839e3920 --- /dev/null +++ b/testsuite/tests/parser/should_fail/InfixAppPatErr.stderr @@ -0,0 +1,4 @@ + +InfixAppPatErr.hs:2:3: error: + Parse error in pattern: f $ do a <- return 3 c + Possibly caused by a missing 'do'? diff --git a/testsuite/tests/parser/should_fail/NoBlockArgumentsFail.hs b/testsuite/tests/parser/should_fail/NoBlockArgumentsFail.hs new file mode 100644 index 0000000000..6c791b0f95 --- /dev/null +++ b/testsuite/tests/parser/should_fail/NoBlockArgumentsFail.hs @@ -0,0 +1,7 @@ +module NoBlockArgumentsFail where + +import Control.Monad + +foo :: IO () +foo = when True do + return () diff --git a/testsuite/tests/parser/should_fail/NoBlockArgumentsFail.stderr b/testsuite/tests/parser/should_fail/NoBlockArgumentsFail.stderr new file mode 100644 index 0000000000..813271bdb9 --- /dev/null +++ b/testsuite/tests/parser/should_fail/NoBlockArgumentsFail.stderr @@ -0,0 +1,6 @@ + +NoBlockArgumentsFail.hs:6:17: error: + Unexpected do block in function application: + do return () + You could write it with parentheses + Or perhaps you meant to enable BlockArguments? diff --git a/testsuite/tests/parser/should_fail/NoBlockArgumentsFail2.hs b/testsuite/tests/parser/should_fail/NoBlockArgumentsFail2.hs new file mode 100644 index 0000000000..752df24081 --- /dev/null +++ b/testsuite/tests/parser/should_fail/NoBlockArgumentsFail2.hs @@ -0,0 +1,6 @@ +module NoBlockArgumentsFail2 where + +import Control.Monad + +foo :: IO () +foo = forM [1 .. 10] \x -> print x diff --git a/testsuite/tests/parser/should_fail/NoBlockArgumentsFail2.stderr b/testsuite/tests/parser/should_fail/NoBlockArgumentsFail2.stderr new file mode 100644 index 0000000000..0361369774 --- /dev/null +++ b/testsuite/tests/parser/should_fail/NoBlockArgumentsFail2.stderr @@ -0,0 +1,6 @@ + +NoBlockArgumentsFail2.hs:6:22: error: + Unexpected lambda expression in function application: + \ x -> print x + You could write it with parentheses + Or perhaps you meant to enable BlockArguments? diff --git a/testsuite/tests/parser/should_fail/NoBlockArgumentsFail3.hs b/testsuite/tests/parser/should_fail/NoBlockArgumentsFail3.hs new file mode 100644 index 0000000000..91bd6e5dec --- /dev/null +++ b/testsuite/tests/parser/should_fail/NoBlockArgumentsFail3.hs @@ -0,0 +1,8 @@ +{-# LANGUAGE LambdaCase #-} +module NoBlockArgumentsFail3 where + +import Control.Monad + +foo :: IO () +foo = forM [1 .. 10] \case + Just 3 -> print x diff --git a/testsuite/tests/parser/should_fail/NoBlockArgumentsFail3.stderr b/testsuite/tests/parser/should_fail/NoBlockArgumentsFail3.stderr new file mode 100644 index 0000000000..e285e6ea72 --- /dev/null +++ b/testsuite/tests/parser/should_fail/NoBlockArgumentsFail3.stderr @@ -0,0 +1,6 @@ + +NoBlockArgumentsFail3.hs:7:22: error: + Unexpected lambda-case expression in function application: + \case Just 3 -> print x + You could write it with parentheses + Or perhaps you meant to enable BlockArguments? diff --git a/testsuite/tests/parser/should_fail/NoNumericUnderscores0.hs b/testsuite/tests/parser/should_fail/NoNumericUnderscores0.hs new file mode 100644 index 0000000000..5e6821124a --- /dev/null +++ b/testsuite/tests/parser/should_fail/NoNumericUnderscores0.hs @@ -0,0 +1,12 @@ +{-# LANGUAGE NoNumericUnderscores #-} + +-- Test for NumericUnderscores extension. +-- See Trac #14473 +-- This is a testcase for integer literal +-- in NO NumericUnderscores extension. + +module NoNumericUnderscores0 where + +f :: Int -> () +f 1_000 = () +f _ = () diff --git a/testsuite/tests/parser/should_fail/NoNumericUnderscores0.stderr b/testsuite/tests/parser/should_fail/NoNumericUnderscores0.stderr new file mode 100644 index 0000000000..af59581c14 --- /dev/null +++ b/testsuite/tests/parser/should_fail/NoNumericUnderscores0.stderr @@ -0,0 +1,3 @@ + +NoNumericUnderscores0.hs:11:3: error: + Use NumericUnderscores to allow underscores in integer literals diff --git a/testsuite/tests/parser/should_fail/NoNumericUnderscores1.hs b/testsuite/tests/parser/should_fail/NoNumericUnderscores1.hs new file mode 100644 index 0000000000..017f20528b --- /dev/null +++ b/testsuite/tests/parser/should_fail/NoNumericUnderscores1.hs @@ -0,0 +1,12 @@ +{-# LANGUAGE NoNumericUnderscores #-} + +-- Test for NumericUnderscores extension. +-- See Trac #14473 +-- This is a testcase for floating literal +-- in NO NumericUnderscores extension. + +module NoNumericUnderscores1 where + +f :: Float -> () +f 1_000.0_1 = () +f _ = () diff --git a/testsuite/tests/parser/should_fail/NoNumericUnderscores1.stderr b/testsuite/tests/parser/should_fail/NoNumericUnderscores1.stderr new file mode 100644 index 0000000000..0dfbaa409e --- /dev/null +++ b/testsuite/tests/parser/should_fail/NoNumericUnderscores1.stderr @@ -0,0 +1,3 @@ + +NoNumericUnderscores1.hs:11:3: error: + Use NumericUnderscores to allow underscores in floating literals diff --git a/testsuite/tests/parser/should_fail/NumericUnderscoresFail0.hs b/testsuite/tests/parser/should_fail/NumericUnderscoresFail0.hs new file mode 100644 index 0000000000..1f04184365 --- /dev/null +++ b/testsuite/tests/parser/should_fail/NumericUnderscoresFail0.hs @@ -0,0 +1,13 @@ +{-# LANGUAGE NumericUnderscores #-} + +-- Test for NumericUnderscores extension. +-- See Trac #14473 +-- This is a testcase for invalid case of NumericUnderscores. + +main :: IO () +main = do + print [ + -- integer + 1000000_, + _1000000 + ] diff --git a/testsuite/tests/parser/should_fail/NumericUnderscoresFail0.stderr b/testsuite/tests/parser/should_fail/NumericUnderscoresFail0.stderr new file mode 100644 index 0000000000..8c872575a5 --- /dev/null +++ b/testsuite/tests/parser/should_fail/NumericUnderscoresFail0.stderr @@ -0,0 +1,4 @@ +NumericUnderscoresFail0.hs:9:5: error: +NumericUnderscoresFail0.hs:11:13: error: +NumericUnderscoresFail0.hs:11:20: error: +NumericUnderscoresFail0.hs:12:13: error: diff --git a/testsuite/tests/parser/should_fail/NumericUnderscoresFail1.hs b/testsuite/tests/parser/should_fail/NumericUnderscoresFail1.hs new file mode 100644 index 0000000000..0a6a3051d6 --- /dev/null +++ b/testsuite/tests/parser/should_fail/NumericUnderscoresFail1.hs @@ -0,0 +1,20 @@ +{-# LANGUAGE NumericUnderscores #-} + +-- Test for NumericUnderscores extension. +-- See Trac #14473 +-- This is a testcase for invalid case of NumericUnderscores. + +main :: IO () +main = do + print [ + -- float + 0_.0001, + _0.0001, + 0.0001_, + 0._0001, + + -- float with exponent + 1e_+23, + 1e+23_, + 1e+_23 + ] diff --git a/testsuite/tests/parser/should_fail/NumericUnderscoresFail1.stderr b/testsuite/tests/parser/should_fail/NumericUnderscoresFail1.stderr new file mode 100644 index 0000000000..e1c91de091 --- /dev/null +++ b/testsuite/tests/parser/should_fail/NumericUnderscoresFail1.stderr @@ -0,0 +1,7 @@ +NumericUnderscoresFail1.hs:11:14: error: +NumericUnderscoresFail1.hs:13:19: error: +NumericUnderscoresFail1.hs:14:15: error: +NumericUnderscoresFail1.hs:17:14: error: Variable not in scope: e_ +NumericUnderscoresFail1.hs:18:18: error: +NumericUnderscoresFail1.hs:19:14: error: Variable not in scope: e +NumericUnderscoresFail1.hs:19:16: error: diff --git a/testsuite/tests/parser/should_fail/ParserNoLambdaCase.stderr b/testsuite/tests/parser/should_fail/ParserNoLambdaCase.stderr index 5eb8b539a3..24d5cfc168 100644 --- a/testsuite/tests/parser/should_fail/ParserNoLambdaCase.stderr +++ b/testsuite/tests/parser/should_fail/ParserNoLambdaCase.stderr @@ -1,2 +1,2 @@ - -ParserNoLambdaCase.hs:3:6: error: parse error on input ‘case’ +ParserNoLambdaCase.hs:3:6: + Illegal lambda-case (use -XLambdaCase) diff --git a/testsuite/tests/parser/should_fail/T13450.hs b/testsuite/tests/parser/should_fail/T13450.hs new file mode 100644 index 0000000000..b36cca0719 --- /dev/null +++ b/testsuite/tests/parser/should_fail/T13450.hs @@ -0,0 +1,4 @@ +module T13450 where + +example = foo + where foo = '' diff --git a/testsuite/tests/parser/should_fail/T13450.stderr b/testsuite/tests/parser/should_fail/T13450.stderr new file mode 100644 index 0000000000..6e0beb32cc --- /dev/null +++ b/testsuite/tests/parser/should_fail/T13450.stderr @@ -0,0 +1,4 @@ + +T13450.hs:4:15: error: + Parser error on `''` + Character literals may not be empty diff --git a/testsuite/tests/parser/should_fail/T13450TH.hs b/testsuite/tests/parser/should_fail/T13450TH.hs new file mode 100644 index 0000000000..c851049582 --- /dev/null +++ b/testsuite/tests/parser/should_fail/T13450TH.hs @@ -0,0 +1,6 @@ +{-# LANGUAGE TemplateHaskell #-} + +module T13450TH where + +example = foo + where foo = '' diff --git a/testsuite/tests/parser/should_fail/T13450TH.stderr b/testsuite/tests/parser/should_fail/T13450TH.stderr new file mode 100644 index 0000000000..11733c5c91 --- /dev/null +++ b/testsuite/tests/parser/should_fail/T13450TH.stderr @@ -0,0 +1,6 @@ + +T13450TH.hs:6:15: error: + Parser error on `''` + Character literals may not be empty + Or perhaps you intended to use quotation syntax of TemplateHaskell, + but the type variable or constructor is missing diff --git a/testsuite/tests/parser/should_fail/T14588.hs b/testsuite/tests/parser/should_fail/T14588.hs new file mode 100644 index 0000000000..8a0bcecd7b --- /dev/null +++ b/testsuite/tests/parser/should_fail/T14588.hs @@ -0,0 +1,3 @@ +module T14588 where + +main = print (let !x = 1 + 2 in x) diff --git a/testsuite/tests/parser/should_fail/T14588.stderr b/testsuite/tests/parser/should_fail/T14588.stderr new file mode 100644 index 0000000000..cb64103814 --- /dev/null +++ b/testsuite/tests/parser/should_fail/T14588.stderr @@ -0,0 +1,4 @@ + +T14588.hs:3:19: error: + Illegal bang-pattern (use BangPatterns): + ! x diff --git a/testsuite/tests/parser/should_fail/T14740.hs b/testsuite/tests/parser/should_fail/T14740.hs new file mode 100644 index 0000000000..b56687f051 --- /dev/null +++ b/testsuite/tests/parser/should_fail/T14740.hs @@ -0,0 +1,6 @@ +{-# LANGUAGE UnboxedTuples #-} + +module T14740 where + +x :: ((##)) => () +x = () diff --git a/testsuite/tests/parser/should_fail/T14740.stderr b/testsuite/tests/parser/should_fail/T14740.stderr new file mode 100644 index 0000000000..8827873e25 --- /dev/null +++ b/testsuite/tests/parser/should_fail/T14740.stderr @@ -0,0 +1,4 @@ + +T14740.hs:5:7: + Expecting a lifted type, but ‘(# #)’ is unlifted + In the type signature: x :: ((# #)) => () diff --git a/testsuite/tests/parser/should_fail/T15053.hs b/testsuite/tests/parser/should_fail/T15053.hs new file mode 100644 index 0000000000..44154a48c0 --- /dev/null +++ b/testsuite/tests/parser/should_fail/T15053.hs @@ -0,0 +1,3 @@ +{-# OPTIONS_GHC -O1 } +" + #-} diff --git a/testsuite/tests/parser/should_fail/T15053.stderr b/testsuite/tests/parser/should_fail/T15053.stderr new file mode 100644 index 0000000000..0544327c5e --- /dev/null +++ b/testsuite/tests/parser/should_fail/T15053.stderr @@ -0,0 +1,5 @@ +T15053.hs:1:16: + Error while parsing OPTIONS_GHC pragma. + Expecting whitespace-separated list of GHC options. + E.g. {-# OPTIONS_GHC -Wall -O2 #-} + Input was: " -O1 }/n/"/n " diff --git a/testsuite/tests/parser/should_fail/T15209.hs b/testsuite/tests/parser/should_fail/T15209.hs new file mode 100644 index 0000000000..1679d80ba6 --- /dev/null +++ b/testsuite/tests/parser/should_fail/T15209.hs @@ -0,0 +1,7 @@ +{-# LANGUAGE GADTs, TypeOperators #-} +module T15209 where + +import GHC.Prim + +foo :: a ~# Int -> () +foo = () diff --git a/testsuite/tests/parser/should_fail/T15209.stderr b/testsuite/tests/parser/should_fail/T15209.stderr new file mode 100644 index 0000000000..9d1e151cf2 --- /dev/null +++ b/testsuite/tests/parser/should_fail/T15209.stderr @@ -0,0 +1,2 @@ + +T15209.hs:6:10: error: Not in scope: type constructor or class ‘~#’ diff --git a/testsuite/tests/parser/should_fail/T3811c.stderr b/testsuite/tests/parser/should_fail/T3811c.stderr index 4a371165fb..dd219184e7 100644 --- a/testsuite/tests/parser/should_fail/T3811c.stderr +++ b/testsuite/tests/parser/should_fail/T3811c.stderr @@ -1,2 +1,5 @@ -T3811c.hs:6:10: Malformed instance: !Show D +T3811c.hs:6:10: error: + • Unexpected strictness annotation: !Show + strictness annotation cannot appear nested inside a type + • In the instance declaration for ‘!Show D’ diff --git a/testsuite/tests/parser/should_fail/T7848.hs b/testsuite/tests/parser/should_fail/T7848.hs index 25f0af7ee0..920f28e8c9 100644 --- a/testsuite/tests/parser/should_fail/T7848.hs +++ b/testsuite/tests/parser/should_fail/T7848.hs @@ -8,4 +8,4 @@ x (+) ((&)@z) ((:&&) a b) (c :&& d) (e `A` f) (A g h) = y y _ = (&) {-# INLINE (&) #-} {-# SPECIALIZE (&) :: a #-} - (&) = x + (&) = 'c' diff --git a/testsuite/tests/parser/should_fail/T7848.stderr b/testsuite/tests/parser/should_fail/T7848.stderr index 95ac7374ef..413920dbe6 100644 --- a/testsuite/tests/parser/should_fail/T7848.stderr +++ b/testsuite/tests/parser/should_fail/T7848.stderr @@ -1,13 +1,7 @@ -T7848.hs:6:1: error: - • Occurs check: cannot construct the infinite type: - t ~ p0 -> p1 -> A -> A -> A -> A -> p2 -> t - • Relevant bindings include x :: t (bound at T7848.hs:6:1) - T7848.hs:10:9: error: - • Couldn't match expected type ‘t’ with actual type ‘a’ - because type variable ‘a’ would escape its scope - This (rigid, skolem) type variable is bound by + • Couldn't match expected type ‘Char’ with actual type ‘a’ + ‘a’ is a rigid type variable bound by the type signature for: (&) :: forall a. a at T7848.hs:10:9-35 @@ -20,5 +14,4 @@ T7848.hs:10:9: error: y _ = (&) {-# INLINE (&) #-} {-# SPECIALIZE (&) :: a #-} - (&) = x - • Relevant bindings include x :: t (bound at T7848.hs:6:1) + (&) = 'c' diff --git a/testsuite/tests/parser/should_fail/T8258NoGADTs.hs b/testsuite/tests/parser/should_fail/T8258NoGADTs.hs new file mode 100644 index 0000000000..1080233bcd --- /dev/null +++ b/testsuite/tests/parser/should_fail/T8258NoGADTs.hs @@ -0,0 +1,3 @@ +module T8258NoGADTs where + +data T where diff --git a/testsuite/tests/parser/should_fail/T8258NoGADTs.stderr b/testsuite/tests/parser/should_fail/T8258NoGADTs.stderr new file mode 100644 index 0000000000..35f5306274 --- /dev/null +++ b/testsuite/tests/parser/should_fail/T8258NoGADTs.stderr @@ -0,0 +1,5 @@ + +T8258NoGADTs.hs:3:8: error: + Illegal keyword 'where' in data declaration + Perhaps you intended to use GADTs or a similar language + extension to enable syntax: data T where diff --git a/testsuite/tests/parser/should_fail/all.T b/testsuite/tests/parser/should_fail/all.T index abe3da9775..960144c9cb 100644 --- a/testsuite/tests/parser/should_fail/all.T +++ b/testsuite/tests/parser/should_fail/all.T @@ -35,7 +35,8 @@ test('readFail028', normal, compile_fail, ['']) test('readFail029', normal, compile_fail, ['']) test('readFail030', normal, compile_fail, ['']) test('readFail031', normal, compile_fail, ['']) -test('readFail032', expect_broken(314), compile_fail, ['-cpp']) +test('readFail032', when(opsys('darwin'), expect_broken(15662)), + compile_fail, ['-cpp']) test('readFail033', normal, compile_fail, ['']) test('readFail034', normal, compile_fail, ['']) test('readFail035', normal, compile_fail, ['']) @@ -50,6 +51,8 @@ test('readFail043', normal, compile_fail, ['']) test('readFail044', normal, compile_fail, ['']) test('readFail046', normal, compile_fail, ['']) test('readFail047', normal, compile_fail, ['']) +test('readFail048', when(opsys('darwin'), expect_broken(15662)), + compile_fail, ['-cpp -haddock']) test('T3095', normal, compile_fail, ['']) test('T3153', normal, compile_fail, ['']) test('T3751', normal, compile_fail, ['']) @@ -69,6 +72,9 @@ test('T3811f', normal, compile_fail, ['']) test('T3811g', normal, compile_fail, ['']) test('NoDoAndIfThenElse', normal, compile_fail, ['']) test('NoPatternSynonyms', normal, compile_fail, ['']) +test('NoBlockArgumentsFail', normal, compile_fail, ['']) +test('NoBlockArgumentsFail2', normal, compile_fail, ['']) +test('NoBlockArgumentsFail3', normal, compile_fail, ['']) test('NondecreasingIndentationFail', normal, compile_fail, ['']) test('readFailTraditionalRecords1', normal, compile_fail, ['']) test('readFailTraditionalRecords2', normal, compile_fail, ['']) @@ -84,6 +90,7 @@ test('T5425', normal, compile_fail, ['']) test('T984', normal, compile_fail, ['']) test('T7848', normal, compile_fail, ['-dppr-user-length=100']) test('ExportCommaComma', normal, compile_fail, ['']) +test('T8258NoGADTs', normal, compile_fail, ['']) test('T8430', literate, compile_fail, ['']) test('T8431', compile_timeout_multiplier(0.05), compile_fail, ['-XAlternativeLayoutRule']) @@ -102,3 +109,23 @@ test('T8501a', normal, compile_fail, ['']) test('T8501b', normal, compile_fail, ['']) test('T8501c', normal, compile_fail, ['']) test('T12610', normal, compile_fail, ['']) +test('T13450', normal, compile_fail, ['']) +test('T13450TH', normal, compile_fail, ['']) +test('T14588', normal, compile_fail, ['']) +test('T14740', normal, compile_fail, ['']) +test('T15209', normal, compile_fail, ['']) + +test('NoNumericUnderscores0', normal, compile_fail, ['']) +test('NoNumericUnderscores1', normal, compile_fail, ['']) +test('NumericUnderscoresFail0', + grep_errmsg(r'^NumericUnderscoresFail0.hs:'), compile_fail, ['']) +test('NumericUnderscoresFail1', + grep_errmsg(r'^NumericUnderscoresFail1.hs:'), compile_fail, ['']) + +test('InfixAppPatErr', normal, compile_fail, ['']) + +test('typeops_A', normal, compile_fail, ['']) +test('typeops_B', normal, compile_fail, ['']) +test('typeops_C', normal, compile_fail, ['']) +test('typeops_D', normal, compile_fail, ['']) +test('T15053', normal, compile_fail, ['']) diff --git a/testsuite/tests/parser/should_fail/readFail032.hs b/testsuite/tests/parser/should_fail/readFail032.hs index dec758a16f..93e7181033 100644 --- a/testsuite/tests/parser/should_fail/readFail032.hs +++ b/testsuite/tests/parser/should_fail/readFail032.hs @@ -1,4 +1,3 @@ - -- Test for trac #314 {- @@ -8,15 +7,19 @@ up some lines - This - uses - up - some - lines + The + following + pragmas + should + not + be + parsed */ +# 23 +#pragma + -} module ShouldFail where -type_error = "Type error on line 21":"Type error on line 21" - +type_error = "Type error on line 25":"Type error on line 25" diff --git a/testsuite/tests/parser/should_fail/readFail032.stderr b/testsuite/tests/parser/should_fail/readFail032.stderr index 95852c5bbd..7cd106d69a 100644 --- a/testsuite/tests/parser/should_fail/readFail032.stderr +++ b/testsuite/tests/parser/should_fail/readFail032.stderr @@ -1,8 +1,11 @@ -readFail032.hs:21:38: - Couldn't match expected type `[Char]' with actual type `Char' +readFail032.hs:25:38: + Couldn't match type ‘Char’ with ‘[Char]’ Expected type: [[Char]] Actual type: [Char] - In the second argument of `(:)', namely `"Type error on line 21"' - In the expression: - "Type error on line 21" : "Type error on line 21" + In the second argument of ‘(:)’, namely ‘"Type error on line 25"’ + In the expression: + "Type error on line 25" : "Type error on line 25" + In an equation for ‘type_error’: + type_error = "Type error on line 25" : "Type error on line 25" + diff --git a/testsuite/tests/parser/should_fail/readFail036.hs b/testsuite/tests/parser/should_fail/readFail036.hs index 2bb23149dd..15afd980f8 100644 --- a/testsuite/tests/parser/should_fail/readFail036.hs +++ b/testsuite/tests/parser/should_fail/readFail036.hs @@ -1,5 +1,5 @@ - module Foo where -data Foo (a :: *) = Foo a +import Data.Kind (Type) +data Foo (a :: Type) = Foo a diff --git a/testsuite/tests/parser/should_fail/readFail036.stderr b/testsuite/tests/parser/should_fail/readFail036.stderr index 0d22eb8363..a66afacacf 100644 --- a/testsuite/tests/parser/should_fail/readFail036.stderr +++ b/testsuite/tests/parser/should_fail/readFail036.stderr @@ -1,5 +1,5 @@ -readFail036.hs:4:16: - Illegal kind signature: ‘*’ +readFail036.hs:5:16: error: + Illegal kind signature: ‘Type’ Perhaps you intended to use KindSignatures In the data type declaration for ‘Foo’ diff --git a/testsuite/tests/parser/should_fail/readFail037.stderr b/testsuite/tests/parser/should_fail/readFail037.stderr index 6fcd2db206..6b317eb051 100644 --- a/testsuite/tests/parser/should_fail/readFail037.stderr +++ b/testsuite/tests/parser/should_fail/readFail037.stderr @@ -1,5 +1,5 @@ -readFail037.hs:4:1: - Too many parameters for class ‘Foo’ - (Use MultiParamTypeClasses to allow multi-parameter classes) - In the class declaration for ‘Foo’ +readFail037.hs:4:1: error: + • Too many parameters for class ‘Foo’ + (Enable MultiParamTypeClasses to allow multi-parameter classes) + • In the class declaration for ‘Foo’ diff --git a/testsuite/tests/parser/should_fail/readFail041.stderr b/testsuite/tests/parser/should_fail/readFail041.stderr index c5b28a6f0f..028b96510b 100644 --- a/testsuite/tests/parser/should_fail/readFail041.stderr +++ b/testsuite/tests/parser/should_fail/readFail041.stderr @@ -1,5 +1,5 @@ -readFail041.hs:6:1: - Fundeps in class ‘Foo’ - (Use FunctionalDependencies to allow fundeps) - In the class declaration for ‘Foo’ +readFail041.hs:6:1: error: + • Fundeps in class ‘Foo’ + (Enable FunctionalDependencies to allow fundeps) + • In the class declaration for ‘Foo’ diff --git a/testsuite/tests/parser/should_fail/readFail048.hs b/testsuite/tests/parser/should_fail/readFail048.hs new file mode 100644 index 0000000000..2985e5e66f --- /dev/null +++ b/testsuite/tests/parser/should_fail/readFail048.hs @@ -0,0 +1,25 @@ +-- Test for trac #314 + +{-| +/* + This + uses + up + some + lines + The + following + pragmas + should + not + be + parsed + */ +# 23 +#pragma + +-} + +module ShouldFail where + +type_error = "Type error on line 25":"Type error on line 25" diff --git a/testsuite/tests/parser/should_fail/readFail048.stderr b/testsuite/tests/parser/should_fail/readFail048.stderr new file mode 100644 index 0000000000..62276db0c9 --- /dev/null +++ b/testsuite/tests/parser/should_fail/readFail048.stderr @@ -0,0 +1,11 @@ + +readFail048.hs:25:38: + Couldn't match type ‘Char’ with ‘[Char]’ + Expected type: [[Char]] + Actual type: [Char] + In the second argument of ‘(:)’, namely ‘"Type error on line 25"’ + In the expression: + "Type error on line 25" : "Type error on line 25" + In an equation for ‘type_error’: + type_error = "Type error on line 25" : "Type error on line 25" + diff --git a/testsuite/tests/parser/should_fail/typeops_A.hs b/testsuite/tests/parser/should_fail/typeops_A.hs new file mode 100644 index 0000000000..abd7f528c6 --- /dev/null +++ b/testsuite/tests/parser/should_fail/typeops_A.hs @@ -0,0 +1 @@ +type X = 1 + diff --git a/testsuite/tests/parser/should_fail/typeops_A.stderr b/testsuite/tests/parser/should_fail/typeops_A.stderr new file mode 100644 index 0000000000..69f7aac6be --- /dev/null +++ b/testsuite/tests/parser/should_fail/typeops_A.stderr @@ -0,0 +1,2 @@ + +typeops_A.hs:1:12: error: Operator applied to too few arguments: + diff --git a/testsuite/tests/parser/should_fail/typeops_B.hs b/testsuite/tests/parser/should_fail/typeops_B.hs new file mode 100644 index 0000000000..ac65f872de --- /dev/null +++ b/testsuite/tests/parser/should_fail/typeops_B.hs @@ -0,0 +1 @@ +type X = + 1 diff --git a/testsuite/tests/parser/should_fail/typeops_B.stderr b/testsuite/tests/parser/should_fail/typeops_B.stderr new file mode 100644 index 0000000000..030516a27f --- /dev/null +++ b/testsuite/tests/parser/should_fail/typeops_B.stderr @@ -0,0 +1,2 @@ + +typeops_B.hs:1:10: error: Operator applied to too few arguments: + diff --git a/testsuite/tests/parser/should_fail/typeops_C.hs b/testsuite/tests/parser/should_fail/typeops_C.hs new file mode 100644 index 0000000000..e55838934a --- /dev/null +++ b/testsuite/tests/parser/should_fail/typeops_C.hs @@ -0,0 +1 @@ +type X = 1 + + 2 diff --git a/testsuite/tests/parser/should_fail/typeops_C.stderr b/testsuite/tests/parser/should_fail/typeops_C.stderr new file mode 100644 index 0000000000..280323bb67 --- /dev/null +++ b/testsuite/tests/parser/should_fail/typeops_C.stderr @@ -0,0 +1,2 @@ + +typeops_C.hs:1:12: error: Operator applied to too few arguments: + diff --git a/testsuite/tests/parser/should_fail/typeops_D.hs b/testsuite/tests/parser/should_fail/typeops_D.hs new file mode 100644 index 0000000000..655b2f15f0 --- /dev/null +++ b/testsuite/tests/parser/should_fail/typeops_D.hs @@ -0,0 +1 @@ +type X = + diff --git a/testsuite/tests/parser/should_fail/typeops_D.stderr b/testsuite/tests/parser/should_fail/typeops_D.stderr new file mode 100644 index 0000000000..0ce7e29559 --- /dev/null +++ b/testsuite/tests/parser/should_fail/typeops_D.stderr @@ -0,0 +1,2 @@ + +typeops_D.hs:1:10: error: Operator applied to too few arguments: + diff --git a/testsuite/tests/parser/should_run/HexFloatLiterals.hs b/testsuite/tests/parser/should_run/HexFloatLiterals.hs new file mode 100644 index 0000000000..5e71ac340d --- /dev/null +++ b/testsuite/tests/parser/should_run/HexFloatLiterals.hs @@ -0,0 +1,16 @@ +{-# Language HexFloatLiterals #-} + +import Numeric(showHFloat) + +main :: IO () +main = + do print [ 0xF.0 + , 0xF.1, 0xF.01 + , 0xF1p-4, 0xF01p-8 + , 0x0.F1p4, 0x0.00F01p12 + ] + + mapM_ putStrLn [ showHFloat (212.21 :: Double) "" + , showHFloat (-12.76 :: Float) "" + , showHFloat (-0 :: Double) "" + ] diff --git a/testsuite/tests/parser/should_run/HexFloatLiterals.stdout b/testsuite/tests/parser/should_run/HexFloatLiterals.stdout new file mode 100644 index 0000000000..20ce2a245a --- /dev/null +++ b/testsuite/tests/parser/should_run/HexFloatLiterals.stdout @@ -0,0 +1,4 @@ +[15.0,15.0625,15.00390625,15.0625,15.00390625,15.0625,15.00390625] +0x1.a86b851eb851fp7 +-0x1.9851ecp3 +-0x0p+0 diff --git a/testsuite/tests/parser/should_run/NumericUnderscores0.hs b/testsuite/tests/parser/should_run/NumericUnderscores0.hs new file mode 100644 index 0000000000..7aefce95c6 --- /dev/null +++ b/testsuite/tests/parser/should_run/NumericUnderscores0.hs @@ -0,0 +1,101 @@ +{-# LANGUAGE NumericUnderscores #-} +{-# LANGUAGE BinaryLiterals #-} +{-# LANGUAGE HexFloatLiterals #-} +{-# LANGUAGE NegativeLiterals #-} + +-- Test for NumericUnderscores extension. +-- See Trac #14473 +-- This is a testcase for boxed literals. + +main :: IO () +main = do + -- Each case corresponds to the definition of Lexer.x + -- + -- Normal integral literals + -- decimal + print [ 1_000_000 == 1000000, + 1__0 == 10, + 299_792_458 == 299792458, + 8_04_1 == 8041, + 2017_12_31 == 20171231 + ] + + -- binary + print [ 0b01_0000_0000 == 0b0100000000, + 0b1_11_01_0000_0_111 == 0b1110100000111, + 0b1100_1011__1110_1111__0101_0011 == + 0b110010111110111101010011 + ] + + -- octal + print [ 0o1_000_000 == 0o1000000, + 0O1__0 == 0O10 + ] + + -- hexadecimal + print [ 0x1_000_000 == 0x1000000, + 0x1__0 == 0x10, + 0xff_00_00 == 0xff0000, + 0X3fff_ffff == 0x3fffffff + ] + + -- negative decimal + print [ -1_0 == -10 + ] + + -- negative binary + print [ -0b1_0 == -0b10 + ] + + -- negative octal + print [ -0o1_0 == -0o10 + ] + + -- negative hexadecimal + print [ -0x1_0 == -0x10 + ] + + ---- Normal rational literals + -- float + print [ 3.141_592_653_589_793 == 3.141592653589793, + 96_485.332_89 == 96485.33289, + 6.022_140_857e+23 == 6.022140857e+23 + ] + + -- negative float + print [ -1_0.0_1 == -10.01, + -1_0e+2 == -10e+2, + -1_0.0_1e+3 == -10.01e+3 + ] + + -- hexadecimal float + print [ 0xF_F.1F == 0xFF.1F, + 0xF_01p-8 == 0xF01p-8, + 0x0.F_1p4 == 0x0.F1p4 + ] + + -- negative hexadecimal float + print [ -0xF_F.F == -0xFF.F, + -0xF_01p-1 == -0xF01p-1, + -0x0.F_1p1 == -0x0.F1p1 + ] + + -- Additional testcase + -- + -- Validity + print [ 0.000_1 == 0.0001, + 1_0.000_1 == 10.0001, + 1e+23 == 1e+23, + 1_e+23 == 1e+23, + 1__e+23 == 1e+23, + 1.0_e+23 == 1.0e+23, + 1.0_e+2_3 == 1.0e+23, + 1_e23 == 1e23, + 1_e-23 == 1e-23, + 1_0_e23 == 10e23, + 1_0_e-23 == 10e-23, + 0b_01 == 0b01, + 0b__11 == 0b11, + 0x_ff == 0xff, + 0x__ff == 0xff + ] diff --git a/testsuite/tests/parser/should_run/NumericUnderscores0.stdout b/testsuite/tests/parser/should_run/NumericUnderscores0.stdout new file mode 100644 index 0000000000..76f19a8ad9 --- /dev/null +++ b/testsuite/tests/parser/should_run/NumericUnderscores0.stdout @@ -0,0 +1,13 @@ +[True,True,True,True,True] +[True,True,True] +[True,True] +[True,True,True,True] +[True] +[True] +[True] +[True] +[True,True,True] +[True,True,True] +[True,True,True] +[True,True,True] +[True,True,True,True,True,True,True,True,True,True,True,True,True,True,True] diff --git a/testsuite/tests/parser/should_run/NumericUnderscores1.hs b/testsuite/tests/parser/should_run/NumericUnderscores1.hs new file mode 100644 index 0000000000..b9d0dca725 --- /dev/null +++ b/testsuite/tests/parser/should_run/NumericUnderscores1.hs @@ -0,0 +1,88 @@ +{-# LANGUAGE NumericUnderscores #-} +{-# LANGUAGE BinaryLiterals #-} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE NegativeLiterals #-} + +-- Test for NumericUnderscores extension. +-- See Trac #14473 +-- This is a testcase for unboxed literals. + +import GHC.Types + +main :: IO () +main = do + -- Each case corresponds to the definition of Lexer.x + -- + -- Unboxed ints and words + -- decimal int + print [ (I# 1_000_000#) == 1000000, + (I# 299_792_458#) == 299792458 + ] + + -- binary int + print [ (I# 0b01_0000_0000#) == 0b0100000000, + (I# 0b1_11_01_0000_0_111#) == 0b1110100000111 + ] + + -- octal int + print [ (I# 0o1_000_000#) == 0o1000000, + (I# 0O1__0#) == 0O10 + ] + + -- hexadecimal int + print [ (I# 0x1_000_000#) == 0x1000000, + (I# 0X3fff_ffff#) == 0x3fffffff + ] + + -- negative decimal int + print [ (I# -1_000_000#) == -1000000 + ] + + -- negative binary int + print [ (I# -0b01_0000_0000#) == -0b0100000000 + ] + + -- negative octal int + print [ (I# -0o1_000_000#) == -0o1000000 + ] + + -- negative hexadecimal int + print [ (I# -0x1_000_000#) == -0x1000000 + ] + + -- decimal word + print [ (W# 1_000_000##) == 1000000, + (W# 299_792_458##) == 299792458 + ] + + -- binary word + print [ (W# 0b1_0##) == 0b10 + ] + + -- octal word + print [ (W# 0o1_0##) == 0o10 + ] + + -- hexadecimal word + print [ (W# 0x1_0##) == 0x10 + ] + + -- Unboxed floats and doubles + -- float + print [ (F# 3.141_592_653_589_793#) == 3.141592653589793, + (F# 3_14e-2#) == 314e-2, + (F# 96_485.332_89#) == 96485.33289, + (F# 6.022_140_857e+23#) == 6.022140857e+23, + (F# -3.141_592#) == -3.141592, + (F# -3_14e-2#) == -314e-2, + (F# -6.022_140e+23#) == -6.022140e+23 + ] + + -- double + print [ (D# 3_14e-2##) == 314e-2, + (D# 96_485.332_89##) == 96485.33289, + (D# 6.022_140_857e+23##) == 6.022140857e+23, + (D# -3.141_592##) == -3.141592, + (D# -3_14e-2##) == -314e-2, + (D# -6.022_140e+23##) == -6.022140e+23 + ] diff --git a/testsuite/tests/parser/should_run/NumericUnderscores1.stdout b/testsuite/tests/parser/should_run/NumericUnderscores1.stdout new file mode 100644 index 0000000000..bddde5bccb --- /dev/null +++ b/testsuite/tests/parser/should_run/NumericUnderscores1.stdout @@ -0,0 +1,14 @@ +[True,True] +[True,True] +[True,True] +[True,True] +[True] +[True] +[True] +[True] +[True,True] +[True] +[True] +[True] +[True,True,True,True,True,True,True] +[True,True,True,True,True,True] diff --git a/testsuite/tests/parser/should_run/all.T b/testsuite/tests/parser/should_run/all.T index 31dea7f5b7..0c9e65fd14 100644 --- a/testsuite/tests/parser/should_run/all.T +++ b/testsuite/tests/parser/should_run/all.T @@ -11,3 +11,6 @@ test('BinaryLiterals1', [], compile_and_run, ['']) test('BinaryLiterals2', [], compile_and_run, ['']) test('T10807', normal, compile_and_run, ['']) test('NegativeZero', normal, compile_and_run, ['']) +test('HexFloatLiterals', normal, compile_and_run, ['']) +test('NumericUnderscores0', normal, compile_and_run, ['']) +test('NumericUnderscores1', normal, compile_and_run, ['']) diff --git a/testsuite/tests/partial-sigs/should_compile/ADT.stderr b/testsuite/tests/partial-sigs/should_compile/ADT.stderr index e801b5963d..ce0f93ac47 100644 --- a/testsuite/tests/partial-sigs/should_compile/ADT.stderr +++ b/testsuite/tests/partial-sigs/should_compile/ADT.stderr @@ -5,5 +5,5 @@ TYPE CONSTRUCTORS data Foo x y z = Foo x y z COERCION AXIOMS Dependent modules: [] -Dependent packages: [base-4.10.0.0, ghc-prim-0.5.1.0, - integer-gmp-1.0.0.1] +Dependent packages: [base-4.12.0.0, ghc-prim-0.5.3, + integer-gmp-1.0.2.0] diff --git a/testsuite/tests/partial-sigs/should_compile/AddAndOr1.stderr b/testsuite/tests/partial-sigs/should_compile/AddAndOr1.stderr index b1e7395820..2574e55b40 100644 --- a/testsuite/tests/partial-sigs/should_compile/AddAndOr1.stderr +++ b/testsuite/tests/partial-sigs/should_compile/AddAndOr1.stderr @@ -3,5 +3,5 @@ TYPE SIGNATURES TYPE CONSTRUCTORS COERCION AXIOMS Dependent modules: [] -Dependent packages: [base-4.10.0.0, ghc-prim-0.5.1.0, - integer-gmp-1.0.0.1] +Dependent packages: [base-4.12.0.0, ghc-prim-0.5.3, + integer-gmp-1.0.2.0] diff --git a/testsuite/tests/partial-sigs/should_compile/AddAndOr2.stderr b/testsuite/tests/partial-sigs/should_compile/AddAndOr2.stderr index 8e4a642220..3540207859 100644 --- a/testsuite/tests/partial-sigs/should_compile/AddAndOr2.stderr +++ b/testsuite/tests/partial-sigs/should_compile/AddAndOr2.stderr @@ -3,5 +3,5 @@ TYPE SIGNATURES TYPE CONSTRUCTORS COERCION AXIOMS Dependent modules: [] -Dependent packages: [base-4.10.0.0, ghc-prim-0.5.1.0, - integer-gmp-1.0.0.1] +Dependent packages: [base-4.12.0.0, ghc-prim-0.5.3, + integer-gmp-1.0.2.0] diff --git a/testsuite/tests/partial-sigs/should_compile/AddAndOr3.stderr b/testsuite/tests/partial-sigs/should_compile/AddAndOr3.stderr index 17ed94f4e5..ea8248b5f4 100644 --- a/testsuite/tests/partial-sigs/should_compile/AddAndOr3.stderr +++ b/testsuite/tests/partial-sigs/should_compile/AddAndOr3.stderr @@ -3,5 +3,5 @@ TYPE SIGNATURES TYPE CONSTRUCTORS COERCION AXIOMS Dependent modules: [] -Dependent packages: [base-4.10.0.0, ghc-prim-0.5.1.0, - integer-gmp-1.0.0.1] +Dependent packages: [base-4.12.0.0, ghc-prim-0.5.3, + integer-gmp-1.0.2.0] diff --git a/testsuite/tests/partial-sigs/should_compile/AddAndOr4.stderr b/testsuite/tests/partial-sigs/should_compile/AddAndOr4.stderr index 9f19495c6b..55a2fb28f0 100644 --- a/testsuite/tests/partial-sigs/should_compile/AddAndOr4.stderr +++ b/testsuite/tests/partial-sigs/should_compile/AddAndOr4.stderr @@ -3,5 +3,5 @@ TYPE SIGNATURES TYPE CONSTRUCTORS COERCION AXIOMS Dependent modules: [] -Dependent packages: [base-4.10.0.0, ghc-prim-0.5.1.0, - integer-gmp-1.0.0.1] +Dependent packages: [base-4.12.0.0, ghc-prim-0.5.3, + integer-gmp-1.0.2.0] diff --git a/testsuite/tests/partial-sigs/should_compile/AddAndOr5.stderr b/testsuite/tests/partial-sigs/should_compile/AddAndOr5.stderr index c1e2e8db23..36d5df85d5 100644 --- a/testsuite/tests/partial-sigs/should_compile/AddAndOr5.stderr +++ b/testsuite/tests/partial-sigs/should_compile/AddAndOr5.stderr @@ -3,5 +3,5 @@ TYPE SIGNATURES TYPE CONSTRUCTORS COERCION AXIOMS Dependent modules: [] -Dependent packages: [base-4.10.0.0, ghc-prim-0.5.1.0, - integer-gmp-1.0.0.1] +Dependent packages: [base-4.12.0.0, ghc-prim-0.5.3, + integer-gmp-1.0.2.0] diff --git a/testsuite/tests/partial-sigs/should_compile/AddAndOr6.stderr b/testsuite/tests/partial-sigs/should_compile/AddAndOr6.stderr index 75465783e5..b81f39e2eb 100644 --- a/testsuite/tests/partial-sigs/should_compile/AddAndOr6.stderr +++ b/testsuite/tests/partial-sigs/should_compile/AddAndOr6.stderr @@ -3,5 +3,5 @@ TYPE SIGNATURES TYPE CONSTRUCTORS COERCION AXIOMS Dependent modules: [] -Dependent packages: [base-4.10.0.0, ghc-prim-0.5.1.0, - integer-gmp-1.0.0.1] +Dependent packages: [base-4.12.0.0, ghc-prim-0.5.3, + integer-gmp-1.0.2.0] diff --git a/testsuite/tests/partial-sigs/should_compile/BoolToBool.stderr b/testsuite/tests/partial-sigs/should_compile/BoolToBool.stderr index 43c3313f2f..1993ae096e 100644 --- a/testsuite/tests/partial-sigs/should_compile/BoolToBool.stderr +++ b/testsuite/tests/partial-sigs/should_compile/BoolToBool.stderr @@ -3,5 +3,5 @@ TYPE SIGNATURES TYPE CONSTRUCTORS COERCION AXIOMS Dependent modules: [] -Dependent packages: [base-4.10.0.0, ghc-prim-0.5.1.0, - integer-gmp-1.0.0.1] +Dependent packages: [base-4.12.0.0, ghc-prim-0.5.3, + integer-gmp-1.0.2.0] diff --git a/testsuite/tests/partial-sigs/should_compile/DataFamilyInstanceLHS.stderr b/testsuite/tests/partial-sigs/should_compile/DataFamilyInstanceLHS.stderr index a69185c225..4e0975eb3e 100644 --- a/testsuite/tests/partial-sigs/should_compile/DataFamilyInstanceLHS.stderr +++ b/testsuite/tests/partial-sigs/should_compile/DataFamilyInstanceLHS.stderr @@ -15,10 +15,10 @@ TYPE CONSTRUCTORS data family Sing (a :: k) COERCION AXIOMS axiom DataFamilyInstanceLHS.D:R:SingMyKind_0 :: - Sing = DataFamilyInstanceLHS.R:SingMyKind_ + Sing _ = DataFamilyInstanceLHS.R:SingMyKind_ -- Defined at DataFamilyInstanceLHS.hs:8:15 FAMILY INSTANCES data instance Sing Dependent modules: [] -Dependent packages: [base-4.10.0.0, ghc-prim-0.5.1.0, - integer-gmp-1.0.0.1] +Dependent packages: [base-4.12.0.0, ghc-prim-0.5.3, + integer-gmp-1.0.2.0] diff --git a/testsuite/tests/partial-sigs/should_compile/Defaulting1MROn.stderr b/testsuite/tests/partial-sigs/should_compile/Defaulting1MROn.stderr index 0e65ec0a2d..99dec3df59 100644 --- a/testsuite/tests/partial-sigs/should_compile/Defaulting1MROn.stderr +++ b/testsuite/tests/partial-sigs/should_compile/Defaulting1MROn.stderr @@ -3,5 +3,5 @@ TYPE SIGNATURES TYPE CONSTRUCTORS COERCION AXIOMS Dependent modules: [] -Dependent packages: [base-4.10.0.0, ghc-prim-0.5.1.0, - integer-gmp-1.0.0.1] +Dependent packages: [base-4.12.0.0, ghc-prim-0.5.3, + integer-gmp-1.0.2.0] diff --git a/testsuite/tests/partial-sigs/should_compile/Defaulting2MROff.stderr b/testsuite/tests/partial-sigs/should_compile/Defaulting2MROff.stderr index 1f5d0703ec..635823bc04 100644 --- a/testsuite/tests/partial-sigs/should_compile/Defaulting2MROff.stderr +++ b/testsuite/tests/partial-sigs/should_compile/Defaulting2MROff.stderr @@ -3,5 +3,5 @@ TYPE SIGNATURES TYPE CONSTRUCTORS COERCION AXIOMS Dependent modules: [] -Dependent packages: [base-4.10.0.0, ghc-prim-0.5.1.0, - integer-gmp-1.0.0.1] +Dependent packages: [base-4.12.0.0, ghc-prim-0.5.3, + integer-gmp-1.0.2.0] diff --git a/testsuite/tests/partial-sigs/should_compile/Defaulting2MROn.stderr b/testsuite/tests/partial-sigs/should_compile/Defaulting2MROn.stderr index 1f5d0703ec..635823bc04 100644 --- a/testsuite/tests/partial-sigs/should_compile/Defaulting2MROn.stderr +++ b/testsuite/tests/partial-sigs/should_compile/Defaulting2MROn.stderr @@ -3,5 +3,5 @@ TYPE SIGNATURES TYPE CONSTRUCTORS COERCION AXIOMS Dependent modules: [] -Dependent packages: [base-4.10.0.0, ghc-prim-0.5.1.0, - integer-gmp-1.0.0.1] +Dependent packages: [base-4.12.0.0, ghc-prim-0.5.3, + integer-gmp-1.0.2.0] diff --git a/testsuite/tests/partial-sigs/should_compile/Either.stderr b/testsuite/tests/partial-sigs/should_compile/Either.stderr index 9ab12a3494..a97a933fb4 100644 --- a/testsuite/tests/partial-sigs/should_compile/Either.stderr +++ b/testsuite/tests/partial-sigs/should_compile/Either.stderr @@ -3,5 +3,5 @@ TYPE SIGNATURES TYPE CONSTRUCTORS COERCION AXIOMS Dependent modules: [] -Dependent packages: [base-4.10.0.0, ghc-prim-0.5.1.0, - integer-gmp-1.0.0.1] +Dependent packages: [base-4.12.0.0, ghc-prim-0.5.3, + integer-gmp-1.0.2.0] diff --git a/testsuite/tests/partial-sigs/should_compile/EqualityConstraint.stderr b/testsuite/tests/partial-sigs/should_compile/EqualityConstraint.stderr index 655a6743d4..08b903e9d1 100644 --- a/testsuite/tests/partial-sigs/should_compile/EqualityConstraint.stderr +++ b/testsuite/tests/partial-sigs/should_compile/EqualityConstraint.stderr @@ -3,5 +3,5 @@ TYPE SIGNATURES TYPE CONSTRUCTORS COERCION AXIOMS Dependent modules: [] -Dependent packages: [base-4.10.0.0, ghc-prim-0.5.1.0, - integer-gmp-1.0.0.1] +Dependent packages: [base-4.12.0.0, ghc-prim-0.5.3, + integer-gmp-1.0.2.0] diff --git a/testsuite/tests/partial-sigs/should_compile/Every.stderr b/testsuite/tests/partial-sigs/should_compile/Every.stderr index aa031314fb..900e9d98a3 100644 --- a/testsuite/tests/partial-sigs/should_compile/Every.stderr +++ b/testsuite/tests/partial-sigs/should_compile/Every.stderr @@ -3,5 +3,5 @@ TYPE SIGNATURES TYPE CONSTRUCTORS COERCION AXIOMS Dependent modules: [] -Dependent packages: [base-4.10.0.0, ghc-prim-0.5.1.0, - integer-gmp-1.0.0.1] +Dependent packages: [base-4.12.0.0, ghc-prim-0.5.3, + integer-gmp-1.0.2.0] diff --git a/testsuite/tests/partial-sigs/should_compile/EveryNamed.stderr b/testsuite/tests/partial-sigs/should_compile/EveryNamed.stderr index 18d6e82aa4..037f0712ce 100644 --- a/testsuite/tests/partial-sigs/should_compile/EveryNamed.stderr +++ b/testsuite/tests/partial-sigs/should_compile/EveryNamed.stderr @@ -3,5 +3,5 @@ TYPE SIGNATURES TYPE CONSTRUCTORS COERCION AXIOMS Dependent modules: [] -Dependent packages: [base-4.10.0.0, ghc-prim-0.5.1.0, - integer-gmp-1.0.0.1] +Dependent packages: [base-4.12.0.0, ghc-prim-0.5.3, + integer-gmp-1.0.2.0] diff --git a/testsuite/tests/partial-sigs/should_compile/ExpressionSig.stderr b/testsuite/tests/partial-sigs/should_compile/ExpressionSig.stderr index 43c3313f2f..1993ae096e 100644 --- a/testsuite/tests/partial-sigs/should_compile/ExpressionSig.stderr +++ b/testsuite/tests/partial-sigs/should_compile/ExpressionSig.stderr @@ -3,5 +3,5 @@ TYPE SIGNATURES TYPE CONSTRUCTORS COERCION AXIOMS Dependent modules: [] -Dependent packages: [base-4.10.0.0, ghc-prim-0.5.1.0, - integer-gmp-1.0.0.1] +Dependent packages: [base-4.12.0.0, ghc-prim-0.5.3, + integer-gmp-1.0.2.0] diff --git a/testsuite/tests/partial-sigs/should_compile/ExpressionSigNamed.stderr b/testsuite/tests/partial-sigs/should_compile/ExpressionSigNamed.stderr index 43c3313f2f..1993ae096e 100644 --- a/testsuite/tests/partial-sigs/should_compile/ExpressionSigNamed.stderr +++ b/testsuite/tests/partial-sigs/should_compile/ExpressionSigNamed.stderr @@ -3,5 +3,5 @@ TYPE SIGNATURES TYPE CONSTRUCTORS COERCION AXIOMS Dependent modules: [] -Dependent packages: [base-4.10.0.0, ghc-prim-0.5.1.0, - integer-gmp-1.0.0.1] +Dependent packages: [base-4.12.0.0, ghc-prim-0.5.3, + integer-gmp-1.0.2.0] diff --git a/testsuite/tests/partial-sigs/should_compile/ExtraConstraints1.stderr b/testsuite/tests/partial-sigs/should_compile/ExtraConstraints1.stderr index 488b83fa87..d86d04741f 100644 --- a/testsuite/tests/partial-sigs/should_compile/ExtraConstraints1.stderr +++ b/testsuite/tests/partial-sigs/should_compile/ExtraConstraints1.stderr @@ -1,5 +1,5 @@ TYPE SIGNATURES - arbitCs1 :: forall a. (Eq a, Enum a, Show a) => a -> String + arbitCs1 :: forall a. (Show a, Enum a, Eq a) => a -> String arbitCs2 :: forall a. (Show a, Enum a, Eq a) => a -> String arbitCs3 :: forall a. (Show a, Enum a, Eq a) => a -> String arbitCs4 :: forall a. (Eq a, Show a, Enum a) => a -> String @@ -7,5 +7,5 @@ TYPE SIGNATURES TYPE CONSTRUCTORS COERCION AXIOMS Dependent modules: [] -Dependent packages: [base-4.10.0.0, ghc-prim-0.5.1.0, - integer-gmp-1.0.0.1] +Dependent packages: [base-4.12.0.0, ghc-prim-0.5.3, + integer-gmp-1.0.2.0] diff --git a/testsuite/tests/partial-sigs/should_compile/ExtraConstraints2.stderr b/testsuite/tests/partial-sigs/should_compile/ExtraConstraints2.stderr index 9a1916f9df..b4386838f8 100644 --- a/testsuite/tests/partial-sigs/should_compile/ExtraConstraints2.stderr +++ b/testsuite/tests/partial-sigs/should_compile/ExtraConstraints2.stderr @@ -3,5 +3,5 @@ TYPE SIGNATURES TYPE CONSTRUCTORS COERCION AXIOMS Dependent modules: [] -Dependent packages: [base-4.10.0.0, ghc-prim-0.5.1.0, - integer-gmp-1.0.0.1] +Dependent packages: [base-4.12.0.0, ghc-prim-0.5.3, + integer-gmp-1.0.2.0] diff --git a/testsuite/tests/partial-sigs/should_compile/ExtraConstraints3.stderr b/testsuite/tests/partial-sigs/should_compile/ExtraConstraints3.stderr index 06c97952a5..4a23e06d5b 100644 --- a/testsuite/tests/partial-sigs/should_compile/ExtraConstraints3.stderr +++ b/testsuite/tests/partial-sigs/should_compile/ExtraConstraints3.stderr @@ -21,8 +21,8 @@ TYPE SIGNATURES >> :: forall (m :: * -> *) a b. Monad m => m a -> m b -> m b >>= :: forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b - ^ :: forall b a. (Num a, Integral b) => a -> b -> a - ^^ :: forall a b. (Integral b, Fractional a) => a -> b -> a + ^ :: forall b a. (Integral b, Num a) => a -> b -> a + ^^ :: forall a b. (Fractional a, Integral b) => a -> b -> a abs :: forall a. Num a => a -> a acos :: forall a. Floating a => a -> a acosh :: forall a. Floating a => a -> a @@ -39,7 +39,7 @@ TYPE SIGNATURES atan2 :: forall a. RealFloat a => a -> a -> a atanh :: forall a. Floating a => a -> a break :: forall a. (a -> Bool) -> [a] -> ([a], [a]) - ceiling :: forall a b. (Integral b, RealFrac a) => a -> b + ceiling :: forall a b. (RealFrac a, Integral b) => a -> b compare :: forall a. Ord a => a -> a -> Ordering concat :: forall (t :: * -> *) a. P.Foldable t => t [a] -> [a] concatMap :: @@ -56,7 +56,7 @@ TYPE SIGNATURES dropWhile :: forall a. (a -> Bool) -> [a] -> [a] either :: forall a c b. (a -> c) -> (b -> c) -> Either a b -> c elem :: - forall (t :: * -> *) a. (Eq a, P.Foldable t) => a -> t a -> Bool + forall (t :: * -> *) a. (P.Foldable t, Eq a) => a -> t a -> Bool encodeFloat :: forall a. RealFloat a => Integer -> Int -> a enumFrom :: forall a. Enum a => a -> [a] enumFromThen :: forall a. Enum a => a -> a -> [a] @@ -72,7 +72,7 @@ TYPE SIGNATURES floatDigits :: forall a. RealFloat a => a -> Int floatRadix :: forall a. RealFloat a => a -> Integer floatRange :: forall a. RealFloat a => a -> (Int, Int) - floor :: forall a b. (Integral b, RealFrac a) => a -> b + floor :: forall a b. (RealFrac a, Integral b) => a -> b fmap :: forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b foldl :: @@ -89,7 +89,7 @@ TYPE SIGNATURES forall (t :: * -> *) a. P.Foldable t => (a -> a -> a) -> t a -> a fromEnum :: forall a. Enum a => a -> Int fromInteger :: forall a. Num a => Integer -> a - fromIntegral :: forall a b. (Num b, Integral a) => a -> b + fromIntegral :: forall a b. (Integral a, Num b) => a -> b fromRational :: forall a. Fractional a => Rational -> a fst :: forall a b. (a, b) -> a gcd :: forall a. Integral a => a -> a -> a @@ -118,26 +118,26 @@ TYPE SIGNATURES map :: forall a b. (a -> b) -> [a] -> [b] mapM :: forall (t :: * -> *) (m :: * -> *) a b. - (Monad m, P.Traversable t) => + (P.Traversable t, Monad m) => (a -> m b) -> t a -> m (t b) mapM_ :: forall (t :: * -> *) (m :: * -> *) a b. - (Monad m, P.Foldable t) => + (P.Foldable t, Monad m) => (a -> m b) -> t a -> m () max :: forall a. Ord a => a -> a -> a maxBound :: forall w. Bounded w => w maximum :: - forall (t :: * -> *) a. (Ord a, P.Foldable t) => t a -> a + forall (t :: * -> *) a. (P.Foldable t, Ord a) => t a -> a maybe :: forall b a. b -> (a -> b) -> Maybe a -> b min :: forall a. Ord a => a -> a -> a minBound :: forall w. Bounded w => w minimum :: - forall (t :: * -> *) a. (Ord a, P.Foldable t) => t a -> a + forall (t :: * -> *) a. (P.Foldable t, Ord a) => t a -> a mod :: forall a. Integral a => a -> a -> a negate :: forall a. Num a => a -> a not :: Bool -> Bool notElem :: - forall (t :: * -> *) a. (Eq a, P.Foldable t) => a -> t a -> Bool + forall (t :: * -> *) a. (P.Foldable t, Eq a) => a -> t a -> Bool null :: forall (t :: * -> *) a. P.Foldable t => t a -> Bool odd :: forall a. Integral a => a -> Bool or :: forall (t :: * -> *). P.Foldable t => t Bool -> Bool @@ -146,9 +146,9 @@ TYPE SIGNATURES pred :: forall a. Enum a => a -> a print :: forall a. Show a => a -> IO () product :: - forall (t :: * -> *) a. (Num a, P.Foldable t) => t a -> a + forall (t :: * -> *) a. (P.Foldable t, Num a) => t a -> a properFraction :: - forall a b. (Integral b, RealFrac a) => a -> (b, a) + forall a b. (RealFrac a, Integral b) => a -> (b, a) putChar :: Char -> IO () putStr :: String -> IO () putStrLn :: String -> IO () @@ -162,14 +162,14 @@ TYPE SIGNATURES readParen :: forall a. Bool -> ReadS a -> ReadS a reads :: forall a. Read a => ReadS a readsPrec :: forall a. Read a => Int -> ReadS a - realToFrac :: forall a b. (Fractional b, Real a) => a -> b + realToFrac :: forall a b. (Real a, Fractional b) => a -> b recip :: forall a. Fractional a => a -> a rem :: forall a. Integral a => a -> a -> a repeat :: forall a. a -> [a] replicate :: forall a. Int -> a -> [a] return :: forall (m :: * -> *) a. Monad m => a -> m a reverse :: forall a. [a] -> [a] - round :: forall a b. (Integral b, RealFrac a) => a -> b + round :: forall a b. (RealFrac a, Integral b) => a -> b scaleFloat :: forall a. RealFloat a => Int -> a -> a scanl :: forall b a. (b -> a -> b) -> b -> [a] -> [b] scanl1 :: forall a. (a -> a -> a) -> [a] -> [a] @@ -178,11 +178,11 @@ TYPE SIGNATURES seq :: forall a b. a -> b -> b sequence :: forall (t :: * -> *) (m :: * -> *) a. - (Monad m, P.Traversable t) => + (P.Traversable t, Monad m) => t (m a) -> m (t a) sequence_ :: forall (t :: * -> *) (m :: * -> *) a. - (Monad m, P.Foldable t) => + (P.Foldable t, Monad m) => t (m a) -> m () show :: forall a. Show a => a -> String showChar :: Char -> ShowS @@ -201,7 +201,7 @@ TYPE SIGNATURES sqrt :: forall a. Floating a => a -> a subtract :: forall a. Num a => a -> a -> a succ :: forall a. Enum a => a -> a - sum :: forall (t :: * -> *) a. (Num a, P.Foldable t) => t a -> a + sum :: forall (t :: * -> *) a. (P.Foldable t, Num a) => t a -> a tail :: forall a. [a] -> [a] take :: forall a. Int -> [a] -> [a] takeWhile :: forall a. (a -> Bool) -> [a] -> [a] @@ -210,7 +210,7 @@ TYPE SIGNATURES toEnum :: forall a. Enum a => Int -> a toInteger :: forall a. Integral a => a -> Integer toRational :: forall a. Real a => a -> Rational - truncate :: forall a b. (Integral b, RealFrac a) => a -> b + truncate :: forall a b. (RealFrac a, Integral b) => a -> b uncurry :: forall a b c. (a -> b -> c) -> (a, b) -> c undefined :: forall w. w unlines :: [String] -> String @@ -230,5 +230,5 @@ TYPE SIGNATURES TYPE CONSTRUCTORS COERCION AXIOMS Dependent modules: [] -Dependent packages: [base-4.10.0.0, ghc-prim-0.5.1.0, - integer-gmp-1.0.0.1] +Dependent packages: [base-4.12.0.0, ghc-prim-0.5.3, + integer-gmp-1.0.2.0] diff --git a/testsuite/tests/partial-sigs/should_compile/ExtraNumAMROff.stderr b/testsuite/tests/partial-sigs/should_compile/ExtraNumAMROff.stderr index 05a121fa7d..a806a25ae5 100644 --- a/testsuite/tests/partial-sigs/should_compile/ExtraNumAMROff.stderr +++ b/testsuite/tests/partial-sigs/should_compile/ExtraNumAMROff.stderr @@ -3,5 +3,5 @@ TYPE SIGNATURES TYPE CONSTRUCTORS COERCION AXIOMS Dependent modules: [] -Dependent packages: [base-4.10.0.0, ghc-prim-0.5.1.0, - integer-gmp-1.0.0.1] +Dependent packages: [base-4.12.0.0, ghc-prim-0.5.3, + integer-gmp-1.0.2.0] diff --git a/testsuite/tests/partial-sigs/should_compile/ExtraNumAMROn.stderr b/testsuite/tests/partial-sigs/should_compile/ExtraNumAMROn.stderr index 05a121fa7d..a806a25ae5 100644 --- a/testsuite/tests/partial-sigs/should_compile/ExtraNumAMROn.stderr +++ b/testsuite/tests/partial-sigs/should_compile/ExtraNumAMROn.stderr @@ -3,5 +3,5 @@ TYPE SIGNATURES TYPE CONSTRUCTORS COERCION AXIOMS Dependent modules: [] -Dependent packages: [base-4.10.0.0, ghc-prim-0.5.1.0, - integer-gmp-1.0.0.1] +Dependent packages: [base-4.12.0.0, ghc-prim-0.5.3, + integer-gmp-1.0.2.0] diff --git a/testsuite/tests/partial-sigs/should_compile/Forall1.stderr b/testsuite/tests/partial-sigs/should_compile/Forall1.stderr index c67cd93697..91ad39f869 100644 --- a/testsuite/tests/partial-sigs/should_compile/Forall1.stderr +++ b/testsuite/tests/partial-sigs/should_compile/Forall1.stderr @@ -3,5 +3,5 @@ TYPE SIGNATURES TYPE CONSTRUCTORS COERCION AXIOMS Dependent modules: [] -Dependent packages: [base-4.10.0.0, ghc-prim-0.5.1.0, - integer-gmp-1.0.0.1] +Dependent packages: [base-4.12.0.0, ghc-prim-0.5.3, + integer-gmp-1.0.2.0] diff --git a/testsuite/tests/partial-sigs/should_compile/GenNamed.stderr b/testsuite/tests/partial-sigs/should_compile/GenNamed.stderr index 43c3313f2f..1993ae096e 100644 --- a/testsuite/tests/partial-sigs/should_compile/GenNamed.stderr +++ b/testsuite/tests/partial-sigs/should_compile/GenNamed.stderr @@ -3,5 +3,5 @@ TYPE SIGNATURES TYPE CONSTRUCTORS COERCION AXIOMS Dependent modules: [] -Dependent packages: [base-4.10.0.0, ghc-prim-0.5.1.0, - integer-gmp-1.0.0.1] +Dependent packages: [base-4.12.0.0, ghc-prim-0.5.3, + integer-gmp-1.0.2.0] diff --git a/testsuite/tests/partial-sigs/should_compile/HigherRank1.stderr b/testsuite/tests/partial-sigs/should_compile/HigherRank1.stderr index 527abb9f49..aba15a1c08 100644 --- a/testsuite/tests/partial-sigs/should_compile/HigherRank1.stderr +++ b/testsuite/tests/partial-sigs/should_compile/HigherRank1.stderr @@ -3,5 +3,5 @@ TYPE SIGNATURES TYPE CONSTRUCTORS COERCION AXIOMS Dependent modules: [] -Dependent packages: [base-4.10.0.0, ghc-prim-0.5.1.0, - integer-gmp-1.0.0.1] +Dependent packages: [base-4.12.0.0, ghc-prim-0.5.3, + integer-gmp-1.0.2.0] diff --git a/testsuite/tests/partial-sigs/should_compile/HigherRank2.stderr b/testsuite/tests/partial-sigs/should_compile/HigherRank2.stderr index 527abb9f49..aba15a1c08 100644 --- a/testsuite/tests/partial-sigs/should_compile/HigherRank2.stderr +++ b/testsuite/tests/partial-sigs/should_compile/HigherRank2.stderr @@ -3,5 +3,5 @@ TYPE SIGNATURES TYPE CONSTRUCTORS COERCION AXIOMS Dependent modules: [] -Dependent packages: [base-4.10.0.0, ghc-prim-0.5.1.0, - integer-gmp-1.0.0.1] +Dependent packages: [base-4.12.0.0, ghc-prim-0.5.3, + integer-gmp-1.0.2.0] diff --git a/testsuite/tests/partial-sigs/should_compile/LocalDefinitionBug.stderr b/testsuite/tests/partial-sigs/should_compile/LocalDefinitionBug.stderr index 7754a44a74..5cf1ad8de8 100644 --- a/testsuite/tests/partial-sigs/should_compile/LocalDefinitionBug.stderr +++ b/testsuite/tests/partial-sigs/should_compile/LocalDefinitionBug.stderr @@ -3,5 +3,5 @@ TYPE SIGNATURES TYPE CONSTRUCTORS COERCION AXIOMS Dependent modules: [] -Dependent packages: [base-4.10.0.0, ghc-prim-0.5.1.0, - integer-gmp-1.0.0.1] +Dependent packages: [base-4.12.0.0, ghc-prim-0.5.3, + integer-gmp-1.0.2.0] diff --git a/testsuite/tests/partial-sigs/should_compile/Meltdown.stderr b/testsuite/tests/partial-sigs/should_compile/Meltdown.stderr index 68bea60c09..3dba495799 100644 --- a/testsuite/tests/partial-sigs/should_compile/Meltdown.stderr +++ b/testsuite/tests/partial-sigs/should_compile/Meltdown.stderr @@ -13,5 +13,5 @@ INSTANCES -- Defined at Meltdown.hs:11:10 instance Monad (NukeMonad a b) -- Defined at Meltdown.hs:15:10 Dependent modules: [] -Dependent packages: [base-4.10.0.0, ghc-prim-0.5.1.0, - integer-gmp-1.0.0.1] +Dependent packages: [base-4.12.0.0, ghc-prim-0.5.3, + integer-gmp-1.0.2.0] diff --git a/testsuite/tests/partial-sigs/should_compile/MonoLocalBinds.stderr b/testsuite/tests/partial-sigs/should_compile/MonoLocalBinds.stderr index 7754a44a74..5cf1ad8de8 100644 --- a/testsuite/tests/partial-sigs/should_compile/MonoLocalBinds.stderr +++ b/testsuite/tests/partial-sigs/should_compile/MonoLocalBinds.stderr @@ -3,5 +3,5 @@ TYPE SIGNATURES TYPE CONSTRUCTORS COERCION AXIOMS Dependent modules: [] -Dependent packages: [base-4.10.0.0, ghc-prim-0.5.1.0, - integer-gmp-1.0.0.1] +Dependent packages: [base-4.12.0.0, ghc-prim-0.5.3, + integer-gmp-1.0.2.0] diff --git a/testsuite/tests/partial-sigs/should_compile/NamedTyVar.stderr b/testsuite/tests/partial-sigs/should_compile/NamedTyVar.stderr index bcf41d547b..68ae22633b 100644 --- a/testsuite/tests/partial-sigs/should_compile/NamedTyVar.stderr +++ b/testsuite/tests/partial-sigs/should_compile/NamedTyVar.stderr @@ -3,5 +3,5 @@ TYPE SIGNATURES TYPE CONSTRUCTORS COERCION AXIOMS Dependent modules: [] -Dependent packages: [base-4.10.0.0, ghc-prim-0.5.1.0, - integer-gmp-1.0.0.1] +Dependent packages: [base-4.12.0.0, ghc-prim-0.5.3, + integer-gmp-1.0.2.0] diff --git a/testsuite/tests/partial-sigs/should_compile/NamedWildcardInDataFamilyInstanceLHS.stderr b/testsuite/tests/partial-sigs/should_compile/NamedWildcardInDataFamilyInstanceLHS.stderr index 1b8ce00010..8fae725e61 100644 --- a/testsuite/tests/partial-sigs/should_compile/NamedWildcardInDataFamilyInstanceLHS.stderr +++ b/testsuite/tests/partial-sigs/should_compile/NamedWildcardInDataFamilyInstanceLHS.stderr @@ -14,10 +14,10 @@ TYPE CONSTRUCTORS data family Sing (a :: k) COERCION AXIOMS axiom NamedWildcardInDataFamilyInstanceLHS.D:R:SingMyKind_a0 :: - Sing = NamedWildcardInDataFamilyInstanceLHS.R:SingMyKind_a + Sing _a = NamedWildcardInDataFamilyInstanceLHS.R:SingMyKind_a -- Defined at NamedWildcardInDataFamilyInstanceLHS.hs:8:15 FAMILY INSTANCES data instance Sing Dependent modules: [] -Dependent packages: [base-4.10.0.0, ghc-prim-0.5.1.0, - integer-gmp-1.0.0.1] +Dependent packages: [base-4.12.0.0, ghc-prim-0.5.3, + integer-gmp-1.0.2.0] diff --git a/testsuite/tests/partial-sigs/should_compile/NamedWildcardInTypeFamilyInstanceLHS.stderr b/testsuite/tests/partial-sigs/should_compile/NamedWildcardInTypeFamilyInstanceLHS.stderr index 4307596808..92785a75c4 100644 --- a/testsuite/tests/partial-sigs/should_compile/NamedWildcardInTypeFamilyInstanceLHS.stderr +++ b/testsuite/tests/partial-sigs/should_compile/NamedWildcardInTypeFamilyInstanceLHS.stderr @@ -9,5 +9,5 @@ COERCION AXIOMS F _t = Int -- Defined at NamedWildcardInTypeFamilyInstanceLHS.hs:5:3 Dependent modules: [] -Dependent packages: [base-4.10.0.0, ghc-prim-0.5.1.0, - integer-gmp-1.0.0.1] +Dependent packages: [base-4.12.0.0, ghc-prim-0.5.3, + integer-gmp-1.0.2.0] diff --git a/testsuite/tests/partial-sigs/should_compile/ParensAroundContext.stderr b/testsuite/tests/partial-sigs/should_compile/ParensAroundContext.stderr index 1e76092b12..2c61b5465f 100644 --- a/testsuite/tests/partial-sigs/should_compile/ParensAroundContext.stderr +++ b/testsuite/tests/partial-sigs/should_compile/ParensAroundContext.stderr @@ -3,5 +3,5 @@ TYPE SIGNATURES TYPE CONSTRUCTORS COERCION AXIOMS Dependent modules: [] -Dependent packages: [base-4.10.0.0, ghc-prim-0.5.1.0, - integer-gmp-1.0.0.1] +Dependent packages: [base-4.12.0.0, ghc-prim-0.5.3, + integer-gmp-1.0.2.0] diff --git a/testsuite/tests/partial-sigs/should_compile/PatBind.stderr b/testsuite/tests/partial-sigs/should_compile/PatBind.stderr index bf8affb50d..a784c73f1f 100644 --- a/testsuite/tests/partial-sigs/should_compile/PatBind.stderr +++ b/testsuite/tests/partial-sigs/should_compile/PatBind.stderr @@ -3,5 +3,5 @@ TYPE SIGNATURES TYPE CONSTRUCTORS COERCION AXIOMS Dependent modules: [] -Dependent packages: [base-4.10.0.0, ghc-prim-0.5.1.0, - integer-gmp-1.0.0.1] +Dependent packages: [base-4.12.0.0, ghc-prim-0.5.3, + integer-gmp-1.0.2.0] diff --git a/testsuite/tests/partial-sigs/should_compile/PatBind2.stderr b/testsuite/tests/partial-sigs/should_compile/PatBind2.stderr index a3cb41cc11..43d7d12bdb 100644 --- a/testsuite/tests/partial-sigs/should_compile/PatBind2.stderr +++ b/testsuite/tests/partial-sigs/should_compile/PatBind2.stderr @@ -3,5 +3,5 @@ TYPE SIGNATURES TYPE CONSTRUCTORS COERCION AXIOMS Dependent modules: [] -Dependent packages: [base-4.10.0.0, ghc-prim-0.5.1.0, - integer-gmp-1.0.0.1] +Dependent packages: [base-4.12.0.0, ghc-prim-0.5.3, + integer-gmp-1.0.2.0] diff --git a/testsuite/tests/partial-sigs/should_compile/PatternSig.stderr b/testsuite/tests/partial-sigs/should_compile/PatternSig.stderr index 43c3313f2f..1993ae096e 100644 --- a/testsuite/tests/partial-sigs/should_compile/PatternSig.stderr +++ b/testsuite/tests/partial-sigs/should_compile/PatternSig.stderr @@ -3,5 +3,5 @@ TYPE SIGNATURES TYPE CONSTRUCTORS COERCION AXIOMS Dependent modules: [] -Dependent packages: [base-4.10.0.0, ghc-prim-0.5.1.0, - integer-gmp-1.0.0.1] +Dependent packages: [base-4.12.0.0, ghc-prim-0.5.3, + integer-gmp-1.0.2.0] diff --git a/testsuite/tests/partial-sigs/should_compile/Recursive.stderr b/testsuite/tests/partial-sigs/should_compile/Recursive.stderr index c57002618f..579c554cf7 100644 --- a/testsuite/tests/partial-sigs/should_compile/Recursive.stderr +++ b/testsuite/tests/partial-sigs/should_compile/Recursive.stderr @@ -5,5 +5,5 @@ TYPE SIGNATURES TYPE CONSTRUCTORS COERCION AXIOMS Dependent modules: [] -Dependent packages: [base-4.10.0.0, ghc-prim-0.5.1.0, - integer-gmp-1.0.0.1] +Dependent packages: [base-4.12.0.0, ghc-prim-0.5.3, + integer-gmp-1.0.2.0] diff --git a/testsuite/tests/partial-sigs/should_compile/ScopedNamedWildcards.stderr b/testsuite/tests/partial-sigs/should_compile/ScopedNamedWildcards.stderr index 3aa546704e..dad0d43f66 100644 --- a/testsuite/tests/partial-sigs/should_compile/ScopedNamedWildcards.stderr +++ b/testsuite/tests/partial-sigs/should_compile/ScopedNamedWildcards.stderr @@ -3,5 +3,5 @@ TYPE SIGNATURES TYPE CONSTRUCTORS COERCION AXIOMS Dependent modules: [] -Dependent packages: [base-4.10.0.0, ghc-prim-0.5.1.0, - integer-gmp-1.0.0.1] +Dependent packages: [base-4.12.0.0, ghc-prim-0.5.3, + integer-gmp-1.0.2.0] diff --git a/testsuite/tests/partial-sigs/should_compile/ScopedNamedWildcardsGood.stderr b/testsuite/tests/partial-sigs/should_compile/ScopedNamedWildcardsGood.stderr index d31eafe39e..41d2b9380e 100644 --- a/testsuite/tests/partial-sigs/should_compile/ScopedNamedWildcardsGood.stderr +++ b/testsuite/tests/partial-sigs/should_compile/ScopedNamedWildcardsGood.stderr @@ -3,5 +3,5 @@ TYPE SIGNATURES TYPE CONSTRUCTORS COERCION AXIOMS Dependent modules: [] -Dependent packages: [base-4.10.0.0, ghc-prim-0.5.1.0, - integer-gmp-1.0.0.1] +Dependent packages: [base-4.12.0.0, ghc-prim-0.5.3, + integer-gmp-1.0.2.0] diff --git a/testsuite/tests/partial-sigs/should_compile/ShowNamed.stderr b/testsuite/tests/partial-sigs/should_compile/ShowNamed.stderr index d9a44c3a8b..5d4b15d954 100644 --- a/testsuite/tests/partial-sigs/should_compile/ShowNamed.stderr +++ b/testsuite/tests/partial-sigs/should_compile/ShowNamed.stderr @@ -3,5 +3,5 @@ TYPE SIGNATURES TYPE CONSTRUCTORS COERCION AXIOMS Dependent modules: [] -Dependent packages: [base-4.10.0.0, ghc-prim-0.5.1.0, - integer-gmp-1.0.0.1] +Dependent packages: [base-4.12.0.0, ghc-prim-0.5.3, + integer-gmp-1.0.2.0] diff --git a/testsuite/tests/partial-sigs/should_compile/SimpleGen.stderr b/testsuite/tests/partial-sigs/should_compile/SimpleGen.stderr index ebe89e259a..59ce087640 100644 --- a/testsuite/tests/partial-sigs/should_compile/SimpleGen.stderr +++ b/testsuite/tests/partial-sigs/should_compile/SimpleGen.stderr @@ -3,5 +3,5 @@ TYPE SIGNATURES TYPE CONSTRUCTORS COERCION AXIOMS Dependent modules: [] -Dependent packages: [base-4.10.0.0, ghc-prim-0.5.1.0, - integer-gmp-1.0.0.1] +Dependent packages: [base-4.12.0.0, ghc-prim-0.5.3, + integer-gmp-1.0.2.0] diff --git a/testsuite/tests/partial-sigs/should_compile/SkipMany.stderr b/testsuite/tests/partial-sigs/should_compile/SkipMany.stderr index 0c222cdcc6..5033a0c28f 100644 --- a/testsuite/tests/partial-sigs/should_compile/SkipMany.stderr +++ b/testsuite/tests/partial-sigs/should_compile/SkipMany.stderr @@ -9,5 +9,5 @@ TYPE CONSTRUCTORS data GenParser tok st a = GenParser tok st a COERCION AXIOMS Dependent modules: [] -Dependent packages: [base-4.10.0.0, ghc-prim-0.5.1.0, - integer-gmp-1.0.0.1] +Dependent packages: [base-4.12.0.0, ghc-prim-0.5.3, + integer-gmp-1.0.2.0] diff --git a/testsuite/tests/partial-sigs/should_compile/SomethingShowable.stderr b/testsuite/tests/partial-sigs/should_compile/SomethingShowable.stderr index ca794d7934..262b76d60a 100644 --- a/testsuite/tests/partial-sigs/should_compile/SomethingShowable.stderr +++ b/testsuite/tests/partial-sigs/should_compile/SomethingShowable.stderr @@ -3,12 +3,12 @@ TYPE SIGNATURES TYPE CONSTRUCTORS COERCION AXIOMS Dependent modules: [] -Dependent packages: [base-4.10.0.0, ghc-prim-0.5.1.0, - integer-gmp-1.0.0.1] +Dependent packages: [base-4.12.0.0, ghc-prim-0.5.3, + integer-gmp-1.0.2.0] SomethingShowable.hs:5:1: warning: [-Wsimplifiable-class-constraints (in -Wdefault)] - • The constraint ‘Show Bool’ matches an instance declaration - instance Show Bool -- Defined in ‘GHC.Show’ + • The constraint ‘Show Bool’ matches + instance Show Bool -- Defined in ‘GHC.Show’ This makes type inference for inner bindings fragile; either use MonoLocalBinds, or simplify it using the instance • When checking the inferred type diff --git a/testsuite/tests/partial-sigs/should_compile/SuperCls.stderr b/testsuite/tests/partial-sigs/should_compile/SuperCls.stderr index 01651a4136..a11164482c 100644 --- a/testsuite/tests/partial-sigs/should_compile/SuperCls.stderr +++ b/testsuite/tests/partial-sigs/should_compile/SuperCls.stderr @@ -1,4 +1,4 @@ SuperCls.hs:4:14: warning: [-Wpartial-type-signatures (in -Wdefault)] - • Found type wildcard ‘_’ standing for ‘() :: Constraint’ + • Found type wildcard ‘_’ standing for ‘()’ • In the type signature: f :: (Ord a, _) => a -> Bool diff --git a/testsuite/tests/partial-sigs/should_compile/T10403.stderr b/testsuite/tests/partial-sigs/should_compile/T10403.stderr index d397e1f6ba..229b9e1df1 100644 --- a/testsuite/tests/partial-sigs/should_compile/T10403.stderr +++ b/testsuite/tests/partial-sigs/should_compile/T10403.stderr @@ -1,33 +1,26 @@ T10403.hs:15:7: warning: [-Wpartial-type-signatures (in -Wdefault)] • Found type wildcard ‘_’ standing for ‘Functor f’ - Where: ‘f’ is a rigid type variable bound by - the inferred type of h1 :: Functor f => (a -> b) -> f a -> H f + Where: ‘f’ is a rigid type variable + bound by the inferred type of + h1 :: Functor f => (a -> b) -> f a -> H f at T10403.hs:17:1-41 • In the type signature: h1 :: _ => _ T10403.hs:15:12: warning: [-Wpartial-type-signatures (in -Wdefault)] • Found type wildcard ‘_’ standing for ‘(a -> b) -> f a -> H f’ - Where: ‘b’ is a rigid type variable bound by - the inferred type of h1 :: Functor f => (a -> b) -> f a -> H f - at T10403.hs:17:1-41 - ‘a’ is a rigid type variable bound by - the inferred type of h1 :: Functor f => (a -> b) -> f a -> H f - at T10403.hs:17:1-41 - ‘f’ is a rigid type variable bound by - the inferred type of h1 :: Functor f => (a -> b) -> f a -> H f + Where: ‘b’, ‘a’, ‘f’ are rigid type variables + bound by the inferred type of + h1 :: Functor f => (a -> b) -> f a -> H f at T10403.hs:17:1-41 • In the type signature: h1 :: _ => _ T10403.hs:19:7: warning: [-Wpartial-type-signatures (in -Wdefault)] • Found type wildcard ‘_’ standing for ‘(a -> b) -> f0 a -> H f0’ - Where: ‘b’ is a rigid type variable bound by - the inferred type of h2 :: (a -> b) -> f0 a -> H f0 - at T10403.hs:22:1-41 - ‘a’ is a rigid type variable bound by - the inferred type of h2 :: (a -> b) -> f0 a -> H f0 + Where: ‘f0’ is an ambiguous type variable + ‘b’, ‘a’ are rigid type variables + bound by the inferred type of h2 :: (a -> b) -> f0 a -> H f0 at T10403.hs:22:1-41 - ‘f0’ is an ambiguous type variable • In the type signature: h2 :: _ T10403.hs:22:15: warning: [-Wdeferred-type-errors (in -Wdefault)] @@ -42,7 +35,7 @@ T10403.hs:22:15: warning: [-Wdeferred-type-errors (in -Wdefault)] instance Functor (B t) -- Defined at T10403.hs:10:10 instance Functor I -- Defined at T10403.hs:6:10 ...plus three others - ...plus one instance involving out-of-scope types + ...plus two instances involving out-of-scope types (use -fprint-potential-instances to see them all) • In the second argument of ‘(.)’, namely ‘fmap (const ())’ In the expression: H . fmap (const ()) diff --git a/testsuite/tests/partial-sigs/should_compile/T11016.stderr b/testsuite/tests/partial-sigs/should_compile/T11016.stderr index 343deabe86..49363fb24c 100644 --- a/testsuite/tests/partial-sigs/should_compile/T11016.stderr +++ b/testsuite/tests/partial-sigs/should_compile/T11016.stderr @@ -1,6 +1,6 @@ T11016.hs:5:19: warning: [-Wpartial-type-signatures (in -Wdefault)] - • Found type wildcard ‘_’ standing for ‘() :: Constraint’ + • Found type wildcard ‘_’ standing for ‘()’ • In the type signature: f1 :: (?x :: Int, _) => Int T11016.hs:8:22: warning: [-Wpartial-type-signatures (in -Wdefault)] diff --git a/testsuite/tests/partial-sigs/should_compile/T11192.stderr b/testsuite/tests/partial-sigs/should_compile/T11192.stderr index 0f2d2e09b6..8030276206 100644 --- a/testsuite/tests/partial-sigs/should_compile/T11192.stderr +++ b/testsuite/tests/partial-sigs/should_compile/T11192.stderr @@ -2,7 +2,8 @@ T11192.hs:7:14: warning: [-Wpartial-type-signatures (in -Wdefault)] • Found type wildcard ‘_’ standing for ‘Int -> p -> p’ Where: ‘p’ is a rigid type variable bound by - the inferred type of go :: Int -> p -> p at T11192.hs:8:8-17 + the inferred type of go :: Int -> p -> p + at T11192.hs:8:8-17 • In the type signature: go :: _ In the expression: let @@ -19,10 +20,9 @@ T11192.hs:7:14: warning: [-Wpartial-type-signatures (in -Wdefault)] T11192.hs:13:14: warning: [-Wpartial-type-signatures (in -Wdefault)] • Found type wildcard ‘_’ standing for ‘p -> p1 -> p1’ - Where: ‘p’ is a rigid type variable bound by - the inferred type of go :: p -> p1 -> p1 at T11192.hs:14:8-17 - ‘p1’ is a rigid type variable bound by - the inferred type of go :: p -> p1 -> p1 at T11192.hs:14:8-17 + Where: ‘p’, ‘p1’ are rigid type variables bound by + the inferred type of go :: p -> p1 -> p1 + at T11192.hs:14:8-17 • In the type signature: go :: _ In the expression: let diff --git a/testsuite/tests/partial-sigs/should_compile/T12033.stderr b/testsuite/tests/partial-sigs/should_compile/T12033.stderr index a3b293b0cc..780fb9d41b 100644 --- a/testsuite/tests/partial-sigs/should_compile/T12033.stderr +++ b/testsuite/tests/partial-sigs/should_compile/T12033.stderr @@ -1,15 +1,15 @@ T12033.hs:12:22: warning: [-Wpartial-type-signatures (in -Wdefault)] • Found type wildcard ‘_’ standing for ‘v -> t’ - Where: ‘v’ is a rigid type variable bound by + Where: ‘t’ is a rigid type variable bound by + the inferred types of + makeTuple :: v -> t + makeExpression :: v -> t + at T12033.hs:(11,4)-(13,39) + ‘v’ is a rigid type variable bound by the type signature for: tripleStoreToRuleSet :: forall v. v -> v at T12033.hs:6:1-30 - ‘t’ is a rigid type variable bound by - the inferred type of - makeTuple :: v -> t - makeExpression :: v -> t - at T12033.hs:(11,4)-(13,39) • In the type signature: makeExpression :: _ In an equation for ‘tripleStoreToRuleSet’: tripleStoreToRuleSet getAtom diff --git a/testsuite/tests/partial-sigs/should_compile/T12531.stderr b/testsuite/tests/partial-sigs/should_compile/T12531.stderr index ddd68246a1..a17062d2f0 100644 --- a/testsuite/tests/partial-sigs/should_compile/T12531.stderr +++ b/testsuite/tests/partial-sigs/should_compile/T12531.stderr @@ -7,3 +7,4 @@ T12531.hs:6:11: warning: [-Wtyped-holes (in -Wdefault)] • Relevant bindings include x :: Int# (bound at T12531.hs:6:3) f :: Int# -> Int (bound at T12531.hs:6:1) + Valid hole fits include x :: Int# (bound at T12531.hs:6:3) diff --git a/testsuite/tests/partial-sigs/should_compile/T12844.stderr b/testsuite/tests/partial-sigs/should_compile/T12844.stderr index 8ad3777f2a..7049818a7c 100644 --- a/testsuite/tests/partial-sigs/should_compile/T12844.stderr +++ b/testsuite/tests/partial-sigs/should_compile/T12844.stderr @@ -1,25 +1,10 @@ T12844.hs:12:9: warning: [-Wpartial-type-signatures (in -Wdefault)] • Found type wildcard ‘_’ - standing for ‘(Head rngs ~ '(r, r'), Foo rngs)’ - Where: ‘r’ is a rigid type variable bound by + standing for ‘(Foo rngs, Head rngs ~ '(r, r'))’ + Where: ‘rngs’, ‘r’, ‘k’, ‘r'’, ‘k1’ + are rigid type variables bound by the inferred type of - bar :: (Head rngs ~ '(r, r'), Foo rngs) => FooData rngs - at T12844.hs:13:1-9 - ‘r'’ is a rigid type variable bound by - the inferred type of - bar :: (Head rngs ~ '(r, r'), Foo rngs) => FooData rngs - at T12844.hs:13:1-9 - ‘rngs’ is a rigid type variable bound by - the inferred type of - bar :: (Head rngs ~ '(r, r'), Foo rngs) => FooData rngs - at T12844.hs:13:1-9 - ‘k’ is a rigid type variable bound by - the inferred type of - bar :: (Head rngs ~ '(r, r'), Foo rngs) => FooData rngs - at T12844.hs:13:1-9 - ‘k1’ is a rigid type variable bound by - the inferred type of - bar :: (Head rngs ~ '(r, r'), Foo rngs) => FooData rngs + bar :: (Foo rngs, Head rngs ~ '(r, r')) => FooData rngs at T12844.hs:13:1-9 • In the type signature: bar :: _ => FooData rngs diff --git a/testsuite/tests/partial-sigs/should_compile/T12845.stderr b/testsuite/tests/partial-sigs/should_compile/T12845.stderr index b9d7d60a97..a483c84231 100644 --- a/testsuite/tests/partial-sigs/should_compile/T12845.stderr +++ b/testsuite/tests/partial-sigs/should_compile/T12845.stderr @@ -1,6 +1,6 @@ T12845.hs:18:70: warning: [-Wpartial-type-signatures (in -Wdefault)] - • Found type wildcard ‘_’ standing for ‘() :: Constraint’ + • Found type wildcard ‘_’ standing for ‘()’ • In the type signature: broken :: forall r r' rngs. ('(r, r') ~ Head rngs, Bar r r' ~ 'True, _) => diff --git a/testsuite/tests/partial-sigs/should_compile/T13324_compile.hs b/testsuite/tests/partial-sigs/should_compile/T13324_compile.hs new file mode 100644 index 0000000000..670744e668 --- /dev/null +++ b/testsuite/tests/partial-sigs/should_compile/T13324_compile.hs @@ -0,0 +1,7 @@ +{-# LANGUAGE PartialTypeSignatures #-} +{-# LANGUAGE StandaloneDeriving #-} +module T13324_compile where + +data Option a = None | Some a + +deriving instance _ => Show (Option a) diff --git a/testsuite/tests/partial-sigs/should_compile/T13482.stderr b/testsuite/tests/partial-sigs/should_compile/T13482.stderr index 87eef5caa7..dd46400b1a 100644 --- a/testsuite/tests/partial-sigs/should_compile/T13482.stderr +++ b/testsuite/tests/partial-sigs/should_compile/T13482.stderr @@ -1,17 +1,17 @@ T13482.hs:8:32: warning: [-Wpartial-type-signatures (in -Wdefault)] - • Found type wildcard ‘_’ standing for ‘(Monoid m, Eq m)’ + • Found type wildcard ‘_’ standing for ‘(Eq m, Monoid m)’ Where: ‘m’ is a rigid type variable bound by the inferred type of - minimal1_noksig :: (Monoid m, Eq m) => Int -> Bool + minimal1_noksig :: (Eq m, Monoid m) => Int -> Bool at T13482.hs:9:1-50 • In the type signature: minimal1_noksig :: forall m. _ => Int -> Bool T13482.hs:11:30: warning: [-Wpartial-type-signatures (in -Wdefault)] - • Found type wildcard ‘_’ standing for ‘(Monoid m, Eq m)’ + • Found type wildcard ‘_’ standing for ‘(Eq m, Monoid m)’ Where: ‘m’ is a rigid type variable bound by - the inferred type of minimal1 :: (Monoid m, Eq m) => Bool + the inferred type of minimal1 :: (Eq m, Monoid m) => Bool at T13482.hs:12:1-41 • In the type signature: minimal1 :: forall (m :: *). _ => Bool diff --git a/testsuite/tests/partial-sigs/should_compile/T14217.hs b/testsuite/tests/partial-sigs/should_compile/T14217.hs new file mode 100644 index 0000000000..0992f2f632 --- /dev/null +++ b/testsuite/tests/partial-sigs/should_compile/T14217.hs @@ -0,0 +1,41 @@ +{- # LANGUAGE PartialTypeSignatures #-} +{-# OPTIONS_GHC -Wno-partial-type-signatures #-} + +module T14217 where + +data Foo a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 + a11 a12 a13 a14 a15 a16 a17 a18 a19 a20 + a21 a22 a23 a24 a25 a26 a27 a28 a29 a30 + a31 a32 a33 a34 a35 a36 a37 a38 a39 a40 + a41 a42 a43 a44 a45 a46 a47 a48 a49 a50 + a51 a52 a53 a54 a55 a56 a57 a58 a59 a60 + a61 a62 a63 + = MkFoo + +eq :: ( Eq a1, Eq a2 , Eq a3 , Eq a4 , Eq a5 , Eq a6 , Eq a7 , Eq a8 , Eq a9, Eq a10 + , Eq a11, Eq a12, Eq a13, Eq a14, Eq a15, Eq a16, Eq a17, Eq a18, Eq a19, Eq a20 + , Eq a21, Eq a22, Eq a23, Eq a24, Eq a25, Eq a26, Eq a27, Eq a28, Eq a29, Eq a30 + , Eq a31, Eq a32, Eq a33, Eq a34, Eq a35, Eq a36, Eq a37, Eq a38, Eq a39, Eq a40 + , Eq a41, Eq a42, Eq a43, Eq a44, Eq a45, Eq a46, Eq a47, Eq a48, Eq a49, Eq a50 + , Eq a51, Eq a52, Eq a53, Eq a54, Eq a55, Eq a56, Eq a57, Eq a58, Eq a59, Eq a60 + , Eq a61, Eq a62, Eq a63) + => Foo a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 + a11 a12 a13 a14 a15 a16 a17 a18 a19 a20 + a21 a22 a23 a24 a25 a26 a27 a28 a29 a30 + a31 a32 a33 a34 a35 a36 a37 a38 a39 a40 + a41 a42 a43 a44 a45 a46 a47 a48 a49 a50 + a51 a52 a53 a54 a55 a56 a57 a58 a59 a60 + a61 a62 a63 + -> Bool +eq = error "urk" + +eqFoo :: (_) + => Foo a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 + a11 a12 a13 a14 a15 a16 a17 a18 a19 a20 + a21 a22 a23 a24 a25 a26 a27 a28 a29 a30 + a31 a32 a33 a34 a35 a36 a37 a38 a39 a40 + a41 a42 a43 a44 a45 a46 a47 a48 a49 a50 + a51 a52 a53 a54 a55 a56 a57 a58 a59 a60 + a61 a62 a63 + -> Bool +eqFoo x = eq x diff --git a/testsuite/tests/partial-sigs/should_compile/T14217.stderr b/testsuite/tests/partial-sigs/should_compile/T14217.stderr new file mode 100644 index 0000000000..ebecbb9d5c --- /dev/null +++ b/testsuite/tests/partial-sigs/should_compile/T14217.stderr @@ -0,0 +1,99 @@ + +T14217.hs:32:11: error: + • Found type wildcard ‘_’ + standing for ‘(Eq a1, Eq a2, Eq a3, Eq a4, Eq a5, Eq a6, Eq a7, + Eq a8, Eq a9, Eq a10, Eq a11, Eq a12, Eq a13, Eq a14, Eq a15, + Eq a16, Eq a17, Eq a18, Eq a19, Eq a20, Eq a21, Eq a22, Eq a23, + Eq a24, Eq a25, Eq a26, Eq a27, Eq a28, Eq a29, Eq a30, Eq a31, + Eq a32, Eq a33, Eq a34, Eq a35, Eq a36, Eq a37, Eq a38, Eq a39, + Eq a40, Eq a41, Eq a42, Eq a43, Eq a44, Eq a45, Eq a46, Eq a47, + Eq a48, Eq a49, Eq a50, Eq a51, Eq a52, Eq a53, Eq a54, Eq a55, + Eq a56, Eq a57, Eq a58, Eq a59, Eq a60, Eq a61, Eq a62, Eq a63)’ + Where: ‘a1’, ‘a2’, ‘a3’, ‘a4’, ‘a5’, ‘a6’, ‘a7’, ‘a8’, ‘a9’, ‘a10’, + ‘a11’, ‘a12’, ‘a13’, ‘a14’, ‘a15’, ‘a16’, ‘a17’, ‘a18’, ‘a19’, + ‘a20’, ‘a21’, ‘a22’, ‘a23’, ‘a24’, ‘a25’, ‘a26’, ‘a27’, ‘a28’, + ‘a29’, ‘a30’, ‘a31’, ‘a32’, ‘a33’, ‘a34’, ‘a35’, ‘a36’, ‘a37’, + ‘a38’, ‘a39’, ‘a40’, ‘a41’, ‘a42’, ‘a43’, ‘a44’, ‘a45’, ‘a46’, + ‘a47’, ‘a48’, ‘a49’, ‘a50’, ‘a51’, ‘a52’, ‘a53’, ‘a54’, ‘a55’, + ‘a56’, ‘a57’, ‘a58’, ‘a59’, ‘a60’, ‘a61’, ‘a62’, ‘a63’ + are rigid type variables bound by + the inferred type of + eqFoo :: (Eq a1, Eq a2, Eq a3, Eq a4, Eq a5, Eq a6, Eq a7, Eq a8, + Eq a9, Eq a10, Eq a11, Eq a12, Eq a13, Eq a14, Eq a15, Eq a16, + Eq a17, Eq a18, Eq a19, Eq a20, Eq a21, Eq a22, Eq a23, Eq a24, + Eq a25, Eq a26, Eq a27, Eq a28, Eq a29, Eq a30, Eq a31, Eq a32, + Eq a33, Eq a34, Eq a35, Eq a36, Eq a37, Eq a38, Eq a39, Eq a40, + Eq a41, Eq a42, Eq a43, Eq a44, Eq a45, Eq a46, Eq a47, Eq a48, + Eq a49, Eq a50, Eq a51, Eq a52, Eq a53, Eq a54, Eq a55, Eq a56, + Eq a57, Eq a58, Eq a59, Eq a60, Eq a61, Eq a62, Eq a63) => + Foo + a1 + a2 + a3 + a4 + a5 + a6 + a7 + a8 + a9 + a10 + a11 + a12 + a13 + a14 + a15 + a16 + a17 + a18 + a19 + a20 + a21 + a22 + a23 + a24 + a25 + a26 + a27 + a28 + a29 + a30 + a31 + a32 + a33 + a34 + a35 + a36 + a37 + a38 + a39 + a40 + a41 + a42 + a43 + a44 + a45 + a46 + a47 + a48 + a49 + a50 + a51 + a52 + a53 + a54 + a55 + a56 + a57 + a58 + a59 + a60 + a61 + a62 + a63 + -> Bool + at T14217.hs:41:1-14 + To use the inferred type, enable PartialTypeSignatures + • In the type signature: + eqFoo :: _ => + Foo a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14 a15 a16 a17 a18 a19 a20 a21 a22 a23 a24 a25 a26 a27 a28 a29 a30 a31 a32 a33 a34 a35 a36 a37 a38 a39 a40 a41 a42 a43 a44 a45 a46 a47 a48 a49 a50 a51 a52 a53 a54 a55 a56 a57 a58 a59 a60 a61 a62 a63 + -> Bool diff --git a/testsuite/tests/partial-sigs/should_compile/T14643.hs b/testsuite/tests/partial-sigs/should_compile/T14643.hs new file mode 100644 index 0000000000..b6de27db65 --- /dev/null +++ b/testsuite/tests/partial-sigs/should_compile/T14643.hs @@ -0,0 +1,9 @@ +{-# LANGUAGE PartialTypeSignatures #-} + +module T14653 where + +af, ag :: (Num a,_) => a -> a +-- It's important that one signature covers both + +af y = ag y +ag x = af (x-1) diff --git a/testsuite/tests/partial-sigs/should_compile/T14643.stderr b/testsuite/tests/partial-sigs/should_compile/T14643.stderr new file mode 100644 index 0000000000..c5f204e799 --- /dev/null +++ b/testsuite/tests/partial-sigs/should_compile/T14643.stderr @@ -0,0 +1,8 @@ + +T14643.hs:5:18: warning: [-Wpartial-type-signatures (in -Wdefault)] + • Found type wildcard ‘_’ standing for ‘()’ + • In the type signature: af :: (Num a, _) => a -> a + +T14643.hs:5:18: warning: [-Wpartial-type-signatures (in -Wdefault)] + • Found type wildcard ‘_’ standing for ‘()’ + • In the type signature: ag :: (Num a, _) => a -> a diff --git a/testsuite/tests/partial-sigs/should_compile/T14643a.hs b/testsuite/tests/partial-sigs/should_compile/T14643a.hs new file mode 100644 index 0000000000..47ef519e37 --- /dev/null +++ b/testsuite/tests/partial-sigs/should_compile/T14643a.hs @@ -0,0 +1,9 @@ +{-# LANGUAGE PartialTypeSignatures #-} + +module T14653a where + +af :: (Num a,_) => a -> a +af y = ag y + +ag :: (Num a,_) => a -> a +ag x = af (x-1) diff --git a/testsuite/tests/partial-sigs/should_compile/T14643a.stderr b/testsuite/tests/partial-sigs/should_compile/T14643a.stderr new file mode 100644 index 0000000000..1514ac92ed --- /dev/null +++ b/testsuite/tests/partial-sigs/should_compile/T14643a.stderr @@ -0,0 +1,8 @@ + +T14643a.hs:5:14: warning: [-Wpartial-type-signatures (in -Wdefault)] + • Found type wildcard ‘_’ standing for ‘()’ + • In the type signature: af :: (Num a, _) => a -> a + +T14643a.hs:8:14: warning: [-Wpartial-type-signatures (in -Wdefault)] + • Found type wildcard ‘_’ standing for ‘()’ + • In the type signature: ag :: (Num a, _) => a -> a diff --git a/testsuite/tests/partial-sigs/should_compile/T14715.hs b/testsuite/tests/partial-sigs/should_compile/T14715.hs new file mode 100644 index 0000000000..1a902ac44f --- /dev/null +++ b/testsuite/tests/partial-sigs/should_compile/T14715.hs @@ -0,0 +1,19 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE PartialTypeSignatures #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeFamilies #-} +module T14715 (bench_mulPublic) where + +data Cyc r +data CT zp r'q +class Reduce a b +type family LiftOf b + +bench_mulPublic :: forall z zp zq . (z ~ LiftOf zq, _) => Cyc zp -> Cyc z -> IO (zp,zq) +bench_mulPublic pt sk = do + ct :: CT zp (Cyc zq) <- encrypt sk pt + undefined ct + +encrypt :: forall z zp zq. Reduce z zq => Cyc z -> Cyc zp -> IO (CT zp (Cyc zq)) +encrypt = undefined diff --git a/testsuite/tests/partial-sigs/should_compile/T14715.stderr b/testsuite/tests/partial-sigs/should_compile/T14715.stderr new file mode 100644 index 0000000000..c846b47dd2 --- /dev/null +++ b/testsuite/tests/partial-sigs/should_compile/T14715.stderr @@ -0,0 +1,10 @@ +T14715.hs:13:53: warning: [-Wpartial-type-signatures (in -Wdefault)] + Found type wildcard ‘_’ standing for ‘Reduce (LiftOf zq) zq’ + Where: ‘zq’ is a rigid type variable bound by + the inferred type of + bench_mulPublic :: (z ~ LiftOf zq, Reduce (LiftOf zq) zq) => + Cyc zp -> Cyc z -> IO (zp, zq) + at T14715.hs:(14,1)-(16,14) + In the type signature: + bench_mulPublic :: forall z zp zq. + (z ~ LiftOf zq, _) => Cyc zp -> Cyc z -> IO (zp, zq) diff --git a/testsuite/tests/partial-sigs/should_compile/T15039a.hs b/testsuite/tests/partial-sigs/should_compile/T15039a.hs new file mode 100644 index 0000000000..3430f14bb9 --- /dev/null +++ b/testsuite/tests/partial-sigs/should_compile/T15039a.hs @@ -0,0 +1,41 @@ +{-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE PartialTypeSignatures #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE TypeOperators #-} +{-# OPTIONS_GHC -fdefer-type-errors #-} +module T15039a where + +import Data.Coerce +import Data.Kind +import Data.Type.Coercion +import Data.Type.Equality + +data Dict :: Constraint -> Type where + Dict :: c => Dict c + +ex1 :: Dict ((a :: Type) ~ (b :: Type)) -> () +ex1 (Dict :: _) = () + +ex2 :: Dict ((a :: Type) ~~ (b :: Type)) -> () +ex2 (Dict :: _) = () + +ex3 :: Dict ((a :: Type) ~~ (b :: k)) -> () +ex3 (Dict :: _) = () + +-- Don't know how to make GHC print an unlifted, nominal equality in an error +-- message. +-- +-- ex4, ex5 :: ??? + +ex6 :: Dict (Coercible (a :: Type) (b :: Type)) -> () +ex6 (Dict :: _) = () + +ex7 :: _ => Coercion (a :: Type) (b :: Type) +ex7 = Coercion + +-- Don't know how to make GHC print an unlifted, heterogeneous, +-- representational equality in an error message. +-- +-- ex8 :: ??? diff --git a/testsuite/tests/partial-sigs/should_compile/T15039a.stderr b/testsuite/tests/partial-sigs/should_compile/T15039a.stderr new file mode 100644 index 0000000000..d9c8e1056f --- /dev/null +++ b/testsuite/tests/partial-sigs/should_compile/T15039a.stderr @@ -0,0 +1,56 @@ + +T15039a.hs:19:14: warning: [-Wpartial-type-signatures (in -Wdefault)] + • Found type wildcard ‘_’ standing for ‘Dict (a ~ b)’ + Where: ‘a’, ‘b’ are rigid type variables bound by + the type signature for: + ex1 :: forall a b. Dict (a ~ b) -> () + at T15039a.hs:18:1-45 + • In a pattern type signature: _ + In the pattern: Dict :: _ + In an equation for ‘ex1’: ex1 (Dict :: _) = () + • Relevant bindings include + ex1 :: Dict (a ~ b) -> () (bound at T15039a.hs:19:1) + +T15039a.hs:22:14: warning: [-Wpartial-type-signatures (in -Wdefault)] + • Found type wildcard ‘_’ standing for ‘Dict (a ~ b)’ + Where: ‘a’, ‘b’ are rigid type variables bound by + the type signature for: + ex2 :: forall a b. Dict (a ~ b) -> () + at T15039a.hs:21:1-46 + • In a pattern type signature: _ + In the pattern: Dict :: _ + In an equation for ‘ex2’: ex2 (Dict :: _) = () + • Relevant bindings include + ex2 :: Dict (a ~ b) -> () (bound at T15039a.hs:22:1) + +T15039a.hs:25:14: warning: [-Wpartial-type-signatures (in -Wdefault)] + • Found type wildcard ‘_’ standing for ‘Dict (a ~~ b)’ + Where: ‘a’, ‘b’, ‘k’ are rigid type variables bound by + the type signature for: + ex3 :: forall k a (b :: k). Dict (a ~~ b) -> () + at T15039a.hs:24:1-43 + • In a pattern type signature: _ + In the pattern: Dict :: _ + In an equation for ‘ex3’: ex3 (Dict :: _) = () + • Relevant bindings include + ex3 :: Dict (a ~~ b) -> () (bound at T15039a.hs:25:1) + +T15039a.hs:33:14: warning: [-Wpartial-type-signatures (in -Wdefault)] + • Found type wildcard ‘_’ standing for ‘Dict (Coercible a b)’ + Where: ‘a’, ‘b’ are rigid type variables bound by + the type signature for: + ex6 :: forall a b. Dict (Coercible a b) -> () + at T15039a.hs:32:1-53 + • In a pattern type signature: _ + In the pattern: Dict :: _ + In an equation for ‘ex6’: ex6 (Dict :: _) = () + • Relevant bindings include + ex6 :: Dict (Coercible a b) -> () (bound at T15039a.hs:33:1) + +T15039a.hs:35:8: warning: [-Wpartial-type-signatures (in -Wdefault)] + • Found type wildcard ‘_’ standing for ‘Coercible a b’ + Where: ‘a’, ‘b’ are rigid type variables bound by + the inferred type of ex7 :: Coercible a b => Coercion a b + at T15039a.hs:36:1-14 + • In the type signature: + ex7 :: _ => Coercion (a :: Type) (b :: Type) diff --git a/testsuite/tests/partial-sigs/should_compile/T15039b.hs b/testsuite/tests/partial-sigs/should_compile/T15039b.hs new file mode 100644 index 0000000000..5069e04655 --- /dev/null +++ b/testsuite/tests/partial-sigs/should_compile/T15039b.hs @@ -0,0 +1,41 @@ +{-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE PartialTypeSignatures #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE TypeOperators #-} +{-# OPTIONS_GHC -fdefer-type-errors #-} +module T15039b where + +import Data.Coerce +import Data.Kind +import Data.Type.Coercion +import Data.Type.Equality + +data Dict :: Constraint -> Type where + Dict :: c => Dict c + +ex1 :: Dict ((a :: Type) ~ (b :: Type)) -> () +ex1 (Dict :: _) = () + +ex2 :: Dict ((a :: Type) ~~ (b :: Type)) -> () +ex2 (Dict :: _) = () + +ex3 :: Dict ((a :: Type) ~~ (b :: k)) -> () +ex3 (Dict :: _) = () + +-- Don't know how to make GHC print an unlifted, nominal equality in an error +-- message. +-- +-- ex4, ex5 :: ??? + +ex6 :: Dict (Coercible (a :: Type) (b :: Type)) -> () +ex6 (Dict :: _) = () + +ex7 :: _ => Coercion (a :: Type) (b :: Type) +ex7 = Coercion + +-- Don't know how to make GHC print an unlifted, heterogeneous, +-- representational equality in an error message. +-- +-- ex8 :: ??? diff --git a/testsuite/tests/partial-sigs/should_compile/T15039b.stderr b/testsuite/tests/partial-sigs/should_compile/T15039b.stderr new file mode 100644 index 0000000000..5726c7fa65 --- /dev/null +++ b/testsuite/tests/partial-sigs/should_compile/T15039b.stderr @@ -0,0 +1,57 @@ + +T15039b.hs:19:14: warning: [-Wpartial-type-signatures (in -Wdefault)] + • Found type wildcard ‘_’ standing for ‘Dict ((a :: *) ~ (b :: *))’ + Where: ‘a’, ‘b’ are rigid type variables bound by + the type signature for: + ex1 :: forall a b. Dict ((a :: *) ~ (b :: *)) -> () + at T15039b.hs:18:1-45 + • In a pattern type signature: _ + In the pattern: Dict :: _ + In an equation for ‘ex1’: ex1 (Dict :: _) = () + • Relevant bindings include + ex1 :: Dict ((a :: *) ~ (b :: *)) -> () (bound at T15039b.hs:19:1) + +T15039b.hs:22:14: warning: [-Wpartial-type-signatures (in -Wdefault)] + • Found type wildcard ‘_’ standing for ‘Dict ((a :: *) ~ (b :: *))’ + Where: ‘a’, ‘b’ are rigid type variables bound by + the type signature for: + ex2 :: forall a b. Dict ((a :: *) ~ (b :: *)) -> () + at T15039b.hs:21:1-46 + • In a pattern type signature: _ + In the pattern: Dict :: _ + In an equation for ‘ex2’: ex2 (Dict :: _) = () + • Relevant bindings include + ex2 :: Dict ((a :: *) ~ (b :: *)) -> () (bound at T15039b.hs:22:1) + +T15039b.hs:25:14: warning: [-Wpartial-type-signatures (in -Wdefault)] + • Found type wildcard ‘_’ + standing for ‘Dict ((a :: *) ~~ (b :: k))’ + Where: ‘a’, ‘b’, ‘k’ are rigid type variables bound by + the type signature for: + ex3 :: forall k a (b :: k). Dict ((a :: *) ~~ (b :: k)) -> () + at T15039b.hs:24:1-43 + • In a pattern type signature: _ + In the pattern: Dict :: _ + In an equation for ‘ex3’: ex3 (Dict :: _) = () + • Relevant bindings include + ex3 :: Dict ((a :: *) ~~ (b :: k)) -> () (bound at T15039b.hs:25:1) + +T15039b.hs:33:14: warning: [-Wpartial-type-signatures (in -Wdefault)] + • Found type wildcard ‘_’ standing for ‘Dict (Coercible * a b)’ + Where: ‘a’, ‘b’ are rigid type variables bound by + the type signature for: + ex6 :: forall a b. Dict (Coercible * a b) -> () + at T15039b.hs:32:1-53 + • In a pattern type signature: _ + In the pattern: Dict :: _ + In an equation for ‘ex6’: ex6 (Dict :: _) = () + • Relevant bindings include + ex6 :: Dict (Coercible * a b) -> () (bound at T15039b.hs:33:1) + +T15039b.hs:35:8: warning: [-Wpartial-type-signatures (in -Wdefault)] + • Found type wildcard ‘_’ standing for ‘Coercible * a b’ + Where: ‘a’, ‘b’ are rigid type variables bound by + the inferred type of ex7 :: Coercible * a b => Coercion * a b + at T15039b.hs:36:1-14 + • In the type signature: + ex7 :: _ => Coercion (a :: Type) (b :: Type) diff --git a/testsuite/tests/partial-sigs/should_compile/T15039c.hs b/testsuite/tests/partial-sigs/should_compile/T15039c.hs new file mode 100644 index 0000000000..062404766f --- /dev/null +++ b/testsuite/tests/partial-sigs/should_compile/T15039c.hs @@ -0,0 +1,41 @@ +{-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE PartialTypeSignatures #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE TypeOperators #-} +{-# OPTIONS_GHC -fdefer-type-errors #-} +module T15039c where + +import Data.Coerce +import Data.Kind +import Data.Type.Coercion +import Data.Type.Equality + +data Dict :: Constraint -> Type where + Dict :: c => Dict c + +ex1 :: Dict ((a :: Type) ~ (b :: Type)) -> () +ex1 (Dict :: _) = () + +ex2 :: Dict ((a :: Type) ~~ (b :: Type)) -> () +ex2 (Dict :: _) = () + +ex3 :: Dict ((a :: Type) ~~ (b :: k)) -> () +ex3 (Dict :: _) = () + +-- Don't know how to make GHC print an unlifted, nominal equality in an error +-- message. +-- +-- ex4, ex5 :: ??? + +ex6 :: Dict (Coercible (a :: Type) (b :: Type)) -> () +ex6 (Dict :: _) = () + +ex7 :: _ => Coercion (a :: Type) (b :: Type) +ex7 = Coercion + +-- Don't know how to make GHC print an unlifted, heterogeneous, +-- representational equality in an error message. +-- +-- ex8 :: ??? diff --git a/testsuite/tests/partial-sigs/should_compile/T15039c.stderr b/testsuite/tests/partial-sigs/should_compile/T15039c.stderr new file mode 100644 index 0000000000..29989c2cdc --- /dev/null +++ b/testsuite/tests/partial-sigs/should_compile/T15039c.stderr @@ -0,0 +1,56 @@ + +T15039c.hs:19:14: warning: [-Wpartial-type-signatures (in -Wdefault)] + • Found type wildcard ‘_’ standing for ‘Dict (a ~ b)’ + Where: ‘a’, ‘b’ are rigid type variables bound by + the type signature for: + ex1 :: forall a b. Dict (a ~ b) -> () + at T15039c.hs:18:1-45 + • In a pattern type signature: _ + In the pattern: Dict :: _ + In an equation for ‘ex1’: ex1 (Dict :: _) = () + • Relevant bindings include + ex1 :: Dict (a ~ b) -> () (bound at T15039c.hs:19:1) + +T15039c.hs:22:14: warning: [-Wpartial-type-signatures (in -Wdefault)] + • Found type wildcard ‘_’ standing for ‘Dict (a ~~ b)’ + Where: ‘a’, ‘b’ are rigid type variables bound by + the type signature for: + ex2 :: forall a b. Dict (a ~~ b) -> () + at T15039c.hs:21:1-46 + • In a pattern type signature: _ + In the pattern: Dict :: _ + In an equation for ‘ex2’: ex2 (Dict :: _) = () + • Relevant bindings include + ex2 :: Dict (a ~~ b) -> () (bound at T15039c.hs:22:1) + +T15039c.hs:25:14: warning: [-Wpartial-type-signatures (in -Wdefault)] + • Found type wildcard ‘_’ standing for ‘Dict (a ~~ b)’ + Where: ‘a’, ‘b’, ‘k’ are rigid type variables bound by + the type signature for: + ex3 :: forall k a (b :: k). Dict (a ~~ b) -> () + at T15039c.hs:24:1-43 + • In a pattern type signature: _ + In the pattern: Dict :: _ + In an equation for ‘ex3’: ex3 (Dict :: _) = () + • Relevant bindings include + ex3 :: Dict (a ~~ b) -> () (bound at T15039c.hs:25:1) + +T15039c.hs:33:14: warning: [-Wpartial-type-signatures (in -Wdefault)] + • Found type wildcard ‘_’ standing for ‘Dict (Coercible a b)’ + Where: ‘a’, ‘b’ are rigid type variables bound by + the type signature for: + ex6 :: forall a b. Dict (Coercible a b) -> () + at T15039c.hs:32:1-53 + • In a pattern type signature: _ + In the pattern: Dict :: _ + In an equation for ‘ex6’: ex6 (Dict :: _) = () + • Relevant bindings include + ex6 :: Dict (Coercible a b) -> () (bound at T15039c.hs:33:1) + +T15039c.hs:35:8: warning: [-Wpartial-type-signatures (in -Wdefault)] + • Found type wildcard ‘_’ standing for ‘a ~R# b’ + Where: ‘a’, ‘b’ are rigid type variables bound by + the inferred type of ex7 :: (a ~R# b) => Coercion a b + at T15039c.hs:36:1-14 + • In the type signature: + ex7 :: _ => Coercion (a :: Type) (b :: Type) diff --git a/testsuite/tests/partial-sigs/should_compile/T15039d.hs b/testsuite/tests/partial-sigs/should_compile/T15039d.hs new file mode 100644 index 0000000000..7a87244f99 --- /dev/null +++ b/testsuite/tests/partial-sigs/should_compile/T15039d.hs @@ -0,0 +1,41 @@ +{-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE PartialTypeSignatures #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE TypeOperators #-} +{-# OPTIONS_GHC -fdefer-type-errors #-} +module T15039d where + +import Data.Coerce +import Data.Kind +import Data.Type.Coercion +import Data.Type.Equality + +data Dict :: Constraint -> Type where + Dict :: c => Dict c + +ex1 :: Dict ((a :: Type) ~ (b :: Type)) -> () +ex1 (Dict :: _) = () + +ex2 :: Dict ((a :: Type) ~~ (b :: Type)) -> () +ex2 (Dict :: _) = () + +ex3 :: Dict ((a :: Type) ~~ (b :: k)) -> () +ex3 (Dict :: _) = () + +-- Don't know how to make GHC print an unlifted, nominal equality in an error +-- message. +-- +-- ex4, ex5 :: ??? + +ex6 :: Dict (Coercible (a :: Type) (b :: Type)) -> () +ex6 (Dict :: _) = () + +ex7 :: _ => Coercion (a :: Type) (b :: Type) +ex7 = Coercion + +-- Don't know how to make GHC print an unlifted, heterogeneous, +-- representational equality in an error message. +-- +-- ex8 :: ??? diff --git a/testsuite/tests/partial-sigs/should_compile/T15039d.stderr b/testsuite/tests/partial-sigs/should_compile/T15039d.stderr new file mode 100644 index 0000000000..7a0f4acf26 --- /dev/null +++ b/testsuite/tests/partial-sigs/should_compile/T15039d.stderr @@ -0,0 +1,59 @@ + +T15039d.hs:19:14: warning: [-Wpartial-type-signatures (in -Wdefault)] + • Found type wildcard ‘_’ standing for ‘Dict ((a :: *) ~ (b :: *))’ + Where: ‘a’, ‘b’ are rigid type variables bound by + the type signature for: + ex1 :: forall a b. Dict ((a :: *) ~ (b :: *)) -> () + at T15039d.hs:18:1-45 + • In a pattern type signature: _ + In the pattern: Dict :: _ + In an equation for ‘ex1’: ex1 (Dict :: _) = () + • Relevant bindings include + ex1 :: Dict ((a :: *) ~ (b :: *)) -> () (bound at T15039d.hs:19:1) + +T15039d.hs:22:14: warning: [-Wpartial-type-signatures (in -Wdefault)] + • Found type wildcard ‘_’ + standing for ‘Dict ((a :: *) ~~ (b :: *))’ + Where: ‘a’, ‘b’ are rigid type variables bound by + the type signature for: + ex2 :: forall a b. Dict ((a :: *) ~~ (b :: *)) -> () + at T15039d.hs:21:1-46 + • In a pattern type signature: _ + In the pattern: Dict :: _ + In an equation for ‘ex2’: ex2 (Dict :: _) = () + • Relevant bindings include + ex2 :: Dict ((a :: *) ~~ (b :: *)) -> () (bound at T15039d.hs:22:1) + +T15039d.hs:25:14: warning: [-Wpartial-type-signatures (in -Wdefault)] + • Found type wildcard ‘_’ + standing for ‘Dict ((a :: *) ~~ (b :: k))’ + Where: ‘a’, ‘b’, ‘k’ are rigid type variables bound by + the type signature for: + ex3 :: forall k a (b :: k). Dict ((a :: *) ~~ (b :: k)) -> () + at T15039d.hs:24:1-43 + • In a pattern type signature: _ + In the pattern: Dict :: _ + In an equation for ‘ex3’: ex3 (Dict :: _) = () + • Relevant bindings include + ex3 :: Dict ((a :: *) ~~ (b :: k)) -> () (bound at T15039d.hs:25:1) + +T15039d.hs:33:14: warning: [-Wpartial-type-signatures (in -Wdefault)] + • Found type wildcard ‘_’ standing for ‘Dict (Coercible * a b)’ + Where: ‘a’, ‘b’ are rigid type variables bound by + the type signature for: + ex6 :: forall a b. Dict (Coercible * a b) -> () + at T15039d.hs:32:1-53 + • In a pattern type signature: _ + In the pattern: Dict :: _ + In an equation for ‘ex6’: ex6 (Dict :: _) = () + • Relevant bindings include + ex6 :: Dict (Coercible * a b) -> () (bound at T15039d.hs:33:1) + +T15039d.hs:35:8: warning: [-Wpartial-type-signatures (in -Wdefault)] + • Found type wildcard ‘_’ standing for ‘(a :: *) ~R# (b :: *)’ + Where: ‘a’, ‘b’ are rigid type variables bound by + the inferred type of + ex7 :: ((a :: *) ~R# (b :: *)) => Coercion * a b + at T15039d.hs:36:1-14 + • In the type signature: + ex7 :: _ => Coercion (a :: Type) (b :: Type) diff --git a/testsuite/tests/partial-sigs/should_compile/TypeFamilyInstanceLHS.stderr b/testsuite/tests/partial-sigs/should_compile/TypeFamilyInstanceLHS.stderr index 4bc15fd063..6e61c44ef1 100644 --- a/testsuite/tests/partial-sigs/should_compile/TypeFamilyInstanceLHS.stderr +++ b/testsuite/tests/partial-sigs/should_compile/TypeFamilyInstanceLHS.stderr @@ -11,5 +11,5 @@ FAMILY INSTANCES type instance F Int _ type instance F Bool _ Dependent modules: [] -Dependent packages: [base-4.10.0.0, ghc-prim-0.5.1.0, - integer-gmp-1.0.0.1] +Dependent packages: [base-4.12.0.0, ghc-prim-0.5.3, + integer-gmp-1.0.2.0] diff --git a/testsuite/tests/partial-sigs/should_compile/Uncurry.stderr b/testsuite/tests/partial-sigs/should_compile/Uncurry.stderr index 68c4ebbfa9..c8c7a80962 100644 --- a/testsuite/tests/partial-sigs/should_compile/Uncurry.stderr +++ b/testsuite/tests/partial-sigs/should_compile/Uncurry.stderr @@ -3,5 +3,5 @@ TYPE SIGNATURES TYPE CONSTRUCTORS COERCION AXIOMS Dependent modules: [] -Dependent packages: [base-4.10.0.0, ghc-prim-0.5.1.0, - integer-gmp-1.0.0.1] +Dependent packages: [base-4.12.0.0, ghc-prim-0.5.3, + integer-gmp-1.0.2.0] diff --git a/testsuite/tests/partial-sigs/should_compile/UncurryNamed.stderr b/testsuite/tests/partial-sigs/should_compile/UncurryNamed.stderr index d67abc2680..bdeacf3287 100644 --- a/testsuite/tests/partial-sigs/should_compile/UncurryNamed.stderr +++ b/testsuite/tests/partial-sigs/should_compile/UncurryNamed.stderr @@ -3,5 +3,5 @@ TYPE SIGNATURES TYPE CONSTRUCTORS COERCION AXIOMS Dependent modules: [] -Dependent packages: [base-4.10.0.0, ghc-prim-0.5.1.0, - integer-gmp-1.0.0.1] +Dependent packages: [base-4.12.0.0, ghc-prim-0.5.3, + integer-gmp-1.0.2.0] diff --git a/testsuite/tests/partial-sigs/should_compile/WarningWildcardInstantiations.stderr b/testsuite/tests/partial-sigs/should_compile/WarningWildcardInstantiations.stderr index 5d9ffd2c7e..26ace3144b 100644 --- a/testsuite/tests/partial-sigs/should_compile/WarningWildcardInstantiations.stderr +++ b/testsuite/tests/partial-sigs/should_compile/WarningWildcardInstantiations.stderr @@ -4,8 +4,8 @@ TYPE SIGNATURES TYPE CONSTRUCTORS COERCION AXIOMS Dependent modules: [] -Dependent packages: [base-4.10.0.0, ghc-prim-0.5.1.0, - integer-gmp-1.0.0.1] +Dependent packages: [base-4.12.0.0, ghc-prim-0.5.3, + integer-gmp-1.0.2.0] WarningWildcardInstantiations.hs:5:14: warning: [-Wpartial-type-signatures (in -Wdefault)] • Found type wildcard ‘_a’ standing for ‘a’ @@ -34,10 +34,7 @@ WarningWildcardInstantiations.hs:8:8: warning: [-Wpartial-type-signatures (in -W WarningWildcardInstantiations.hs:8:13: warning: [-Wpartial-type-signatures (in -Wdefault)] • Found type wildcard ‘_’ standing for ‘t -> w’ - Where: ‘t’ is a rigid type variable bound by - the inferred type of bar :: t -> (t -> w) -> w - at WarningWildcardInstantiations.hs:9:1-13 - ‘w’ is a rigid type variable bound by + Where: ‘t’, ‘w’ are rigid type variables bound by the inferred type of bar :: t -> (t -> w) -> w at WarningWildcardInstantiations.hs:9:1-13 • In the type signature: bar :: _ -> _ -> _ diff --git a/testsuite/tests/partial-sigs/should_compile/all.T b/testsuite/tests/partial-sigs/should_compile/all.T index bd0762ec2f..d6eaa7727a 100644 --- a/testsuite/tests/partial-sigs/should_compile/all.T +++ b/testsuite/tests/partial-sigs/should_compile/all.T @@ -38,7 +38,16 @@ test('PatBind', normal, compile, ['-ddump-types -fno-warn-partial-type-signature # Bug test('PatBind2', normal, compile, ['-ddump-types -fno-warn-partial-type-signatures']) test('PatternSig', normal, compile, ['-ddump-types -fno-warn-partial-type-signatures']) -test('PatternSplice', normal, compile, ['-fno-warn-partial-type-signatures']) +# we omit profasm because it doesn't bring much to the table but +# introduces its share of complexity, as the test as it is fails with +# profasm: +# PatternSplice.hs:6:5: fatal: +# Cannot load -prof objects when GHC is built with -dynamic +# To fix this, either: +# (1) Use -fexternal-interpreter, or +# (2) Build the program twice: once with -dynamic, and then +# with -prof using -osuf to set a different object file suffix. +test('PatternSplice', [req_interp, omit_ways(['profasm'])], compile, ['-fno-warn-partial-type-signatures']) test('Recursive', normal, compile, ['-ddump-types -fno-warn-partial-type-signatures']) test('ScopedNamedWildcards', normal, compile, ['-ddump-types -fno-warn-partial-type-signatures']) test('ScopedNamedWildcardsGood', normal, compile, ['-ddump-types -fno-warn-partial-type-signatures']) @@ -53,7 +62,7 @@ test('WarningWildcardInstantiations', normal, compile, ['-ddump-types']) test('SplicesUsed', [extra_files(['Splices.hs']), req_interp, omit_ways(prof_ways)], multimod_compile, ['SplicesUsed', config.ghc_th_way_flags]) -test('TypedSplice', [req_interp, normal], compile, ['']) +test('TypedSplice', normal, compile, ['']) test('T10403', normal, compile, ['']) test('T10438', normal, compile, ['']) test('T10519', normal, compile, ['']) @@ -69,4 +78,14 @@ test('T12156', normal, compile_fail, ['-fdefer-typed-holes']) test('T12531', normal, compile, ['-fdefer-typed-holes']) test('T12845', normal, compile, ['']) test('T12844', normal, compile, ['']) +test('T13324_compile', normal, compile, ['-Wno-partial-type-signatures']) test('T13482', normal, compile, ['']) +test('T14217', normal, compile_fail, ['']) +test('T14643', normal, compile, ['']) +test('T14643a', normal, compile, ['']) +test('T14715', normal, compile, ['']) +test('T15039a', normal, compile, ['']) +test('T15039b', normal, compile, ['-fprint-explicit-kinds']) +test('T15039c', normal, compile, ['-fprint-equality-relations']) +test('T15039d', normal, compile, + ['-fprint-explicit-kinds -fprint-equality-relations']) diff --git a/testsuite/tests/partial-sigs/should_fail/T10045.stderr b/testsuite/tests/partial-sigs/should_fail/T10045.stderr index a18ef48b83..e6f6462d5d 100644 --- a/testsuite/tests/partial-sigs/should_fail/T10045.stderr +++ b/testsuite/tests/partial-sigs/should_fail/T10045.stderr @@ -1,10 +1,9 @@ T10045.hs:6:18: error: • Found type wildcard ‘_’ standing for ‘t1 -> Bool -> t2’ - Where: ‘t1’ is a rigid type variable bound by - the inferred type of copy :: t1 -> Bool -> t2 at T10045.hs:7:10-34 - ‘t2’ is a rigid type variable bound by - the inferred type of copy :: t1 -> Bool -> t2 at T10045.hs:7:10-34 + Where: ‘t1’, ‘t2’ are rigid type variables bound by + the inferred type of copy :: t1 -> Bool -> t2 + at T10045.hs:7:10-34 To use the inferred type, enable PartialTypeSignatures • In the type signature: copy :: _ In the expression: diff --git a/testsuite/tests/partial-sigs/should_fail/T10615.stderr b/testsuite/tests/partial-sigs/should_fail/T10615.stderr index c17759a531..0b9bcb811c 100644 --- a/testsuite/tests/partial-sigs/should_fail/T10615.stderr +++ b/testsuite/tests/partial-sigs/should_fail/T10615.stderr @@ -8,7 +8,8 @@ T10615.hs:4:7: error: T10615.hs:5:6: error: • Couldn't match type ‘f’ with ‘b1 -> a1’ ‘f’ is a rigid type variable bound by - the inferred type of f1 :: a1 -> f at T10615.hs:5:1-10 + the inferred type of f1 :: a1 -> f + at T10615.hs:5:1-10 Expected type: a1 -> f Actual type: a1 -> b1 -> a1 • In the expression: const @@ -24,7 +25,8 @@ T10615.hs:7:7: error: T10615.hs:8:6: error: • Couldn't match type ‘_f’ with ‘b0 -> a0’ ‘_f’ is a rigid type variable bound by - the inferred type of f2 :: a0 -> _f at T10615.hs:8:1-10 + the inferred type of f2 :: a0 -> _f + at T10615.hs:8:1-10 Expected type: a0 -> _f Actual type: a0 -> b0 -> a0 • In the expression: const diff --git a/testsuite/tests/partial-sigs/should_fail/T10999.stderr b/testsuite/tests/partial-sigs/should_fail/T10999.stderr index 0b534b9480..5da96928c4 100644 --- a/testsuite/tests/partial-sigs/should_fail/T10999.stderr +++ b/testsuite/tests/partial-sigs/should_fail/T10999.stderr @@ -24,9 +24,9 @@ T10999.hs:8:28: error: instance Ord a => Ord (Set.Set a) -- Defined in ‘Data.Set.Internal’ instance Ord Ordering -- Defined in ‘GHC.Classes’ instance Ord Integer - -- Defined in ‘integer-gmp-1.0.0.1:GHC.Integer.Type’ - ...plus 23 others - ...plus two instances involving out-of-scope types + -- Defined in ‘integer-gmp-1.0.1.0:GHC.Integer.Type’ + ...plus 22 others + ...plus three instances involving out-of-scope types (use -fprint-potential-instances to see them all) • In the second argument of ‘($)’, namely ‘f ()’ In the second argument of ‘($)’, namely ‘Set.toList $ f ()’ diff --git a/testsuite/tests/partial-sigs/should_fail/T11515.hs b/testsuite/tests/partial-sigs/should_fail/T11515.hs new file mode 100644 index 0000000000..2a03e240a8 --- /dev/null +++ b/testsuite/tests/partial-sigs/should_fail/T11515.hs @@ -0,0 +1,8 @@ +{-# LANGUAGE ConstraintKinds, TypeFamilies #-} + +module T11515 where + +type family ShowSyn a where ShowSyn a = Show a + +foo :: (ShowSyn a, _) => a -> String +foo x = show x diff --git a/testsuite/tests/partial-sigs/should_fail/T11515.stderr b/testsuite/tests/partial-sigs/should_fail/T11515.stderr new file mode 100644 index 0000000000..2870457500 --- /dev/null +++ b/testsuite/tests/partial-sigs/should_fail/T11515.stderr @@ -0,0 +1,5 @@ + +T11515.hs:7:20: error: + • Found type wildcard ‘_’ standing for ‘()’ + To use the inferred type, enable PartialTypeSignatures + • In the type signature: foo :: (ShowSyn a, _) => a -> String diff --git a/testsuite/tests/partial-sigs/should_fail/T11976.stderr b/testsuite/tests/partial-sigs/should_fail/T11976.stderr index f0e2784f6f..28104625e1 100644 --- a/testsuite/tests/partial-sigs/should_fail/T11976.stderr +++ b/testsuite/tests/partial-sigs/should_fail/T11976.stderr @@ -1,7 +1,17 @@ +T11976.hs:7:7: error: + • Cannot instantiate unification variable ‘a0’ + with a type involving foralls: Lens w3 w4 w5 + GHC doesn't yet support impredicative polymorphism + • In the expression: undefined :: Lens _ _ _ + In an equation for ‘foo’: foo = undefined :: Lens _ _ _ + • Relevant bindings include + foo :: Lens w w1 w2 (bound at T11976.hs:7:1) + T11976.hs:7:20: error: - • Illegal polymorphic type: Lens w0 w1 - GHC doesn't yet support impredicative polymorphism - • In an expression type signature: Lens _ _ _ + • Expected kind ‘k0 -> *’, but ‘Lens _ _’ has kind ‘*’ + • In the type ‘Lens _ _ _’ + In an expression type signature: Lens _ _ _ In the expression: undefined :: Lens _ _ _ - In an equation for ‘foo’: foo = undefined :: Lens _ _ _ + • Relevant bindings include + foo :: Lens w w1 w2 (bound at T11976.hs:7:1) diff --git a/testsuite/tests/partial-sigs/should_fail/T12634.stderr b/testsuite/tests/partial-sigs/should_fail/T12634.stderr index 7f1d713c4f..316f7eb2c5 100644 --- a/testsuite/tests/partial-sigs/should_fail/T12634.stderr +++ b/testsuite/tests/partial-sigs/should_fail/T12634.stderr @@ -1,6 +1,6 @@ T12634.hs:14:37: error: - • Found type wildcard ‘_’ standing for ‘() :: Constraint’ + • Found type wildcard ‘_’ standing for ‘()’ To use the inferred type, enable PartialTypeSignatures • In the type signature: bench_twacePow :: forall t m m' r. @@ -15,3 +15,17 @@ T12634.hs:14:58: error: In the type signature: bench_twacePow :: forall t m m' r. _ => t m' r -> Bench '(t, m, m', r) + +T12634.hs:15:18: error: + • Couldn't match kind ‘(* -> * -> *, *, *, *)’ with ‘*’ + When matching types + params0 :: * + '(t, m, m', r) :: (* -> * -> *, *, *, *) + Expected type: t m' r -> Bench '(t, m, m', r) + Actual type: t m' r -> Bench params0 + • In the expression: bench (twacePowDec :: t m' r -> t m r) + In an equation for ‘bench_twacePow’: + bench_twacePow = bench (twacePowDec :: t m' r -> t m r) + • Relevant bindings include + bench_twacePow :: t m' r -> Bench '(t, m, m', r) + (bound at T12634.hs:15:1) diff --git a/testsuite/tests/partial-sigs/should_fail/T13324_fail1.hs b/testsuite/tests/partial-sigs/should_fail/T13324_fail1.hs new file mode 100644 index 0000000000..a177cbdbd9 --- /dev/null +++ b/testsuite/tests/partial-sigs/should_fail/T13324_fail1.hs @@ -0,0 +1,8 @@ +{-# LANGUAGE PartialTypeSignatures #-} +{-# LANGUAGE StandaloneDeriving #-} +module T13324_fail1 where + +data Option a = None | Some a + +deriving instance (Eq a, _) => Eq (Option a) +deriving instance (Show _) => Show (Option a) diff --git a/testsuite/tests/partial-sigs/should_fail/T13324_fail1.stderr b/testsuite/tests/partial-sigs/should_fail/T13324_fail1.stderr new file mode 100644 index 0000000000..dd3a9948f9 --- /dev/null +++ b/testsuite/tests/partial-sigs/should_fail/T13324_fail1.stderr @@ -0,0 +1,10 @@ + +T13324_fail1.hs:7:26: error: + Extra-constraint wildcard ‘_’ not allowed + except as the sole constraint + e.g., deriving instance _ => Eq (Foo a) + in a deriving declaration + +T13324_fail1.hs:8:25: error: + Wildcard ‘_’ not allowed + in a deriving declaration diff --git a/testsuite/tests/partial-sigs/should_fail/T13324_fail2.hs b/testsuite/tests/partial-sigs/should_fail/T13324_fail2.hs new file mode 100644 index 0000000000..41f36c7b20 --- /dev/null +++ b/testsuite/tests/partial-sigs/should_fail/T13324_fail2.hs @@ -0,0 +1,11 @@ +{-# LANGUAGE GADTs #-} +{-# LANGUAGE PartialTypeSignatures #-} +{-# LANGUAGE StandaloneDeriving #-} +module T13324_fail2 where + +newtype Foo f a = Foo (f (f a)) +deriving instance _ => Eq (Foo f a) + +data T a where + MkT :: T Int +deriving instance _ => Eq (T a) diff --git a/testsuite/tests/partial-sigs/should_fail/T13324_fail2.stderr b/testsuite/tests/partial-sigs/should_fail/T13324_fail2.stderr new file mode 100644 index 0000000000..75e4829cdb --- /dev/null +++ b/testsuite/tests/partial-sigs/should_fail/T13324_fail2.stderr @@ -0,0 +1,12 @@ + +T13324_fail2.hs:7:1: error: + • No instance for (Eq (f (f a))) + arising from a 'deriving' declaration + Possible fix: fill in the wildcard constraint yourself + • When deriving the instance for (Eq (Foo f a)) + +T13324_fail2.hs:11:1: error: + • Can't make a derived instance of ‘Eq (T a)’: + Constructor ‘MkT’ is a GADT + Possible fix: fill in the wildcard constraint yourself + • In the stand-alone deriving instance for ‘_ => Eq (T a)’ diff --git a/testsuite/tests/partial-sigs/should_fail/T14040a.hs b/testsuite/tests/partial-sigs/should_fail/T14040a.hs new file mode 100644 index 0000000000..2985339f49 --- /dev/null +++ b/testsuite/tests/partial-sigs/should_fail/T14040a.hs @@ -0,0 +1,34 @@ +{-# LANGUAGE GADTs #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE DataKinds, PolyKinds #-} +module T14040a where + +import Data.Kind + +data family Sing (a :: k) + +data WeirdList :: Type -> Type where + WeirdNil :: WeirdList a + WeirdCons :: a -> WeirdList (WeirdList a) -> WeirdList a + +data instance Sing (z :: WeirdList a) where + SWeirdNil :: Sing WeirdNil + SWeirdCons :: Sing w -> Sing wws -> Sing (WeirdCons w wws) + +elimWeirdList :: forall (a :: Type) (wl :: WeirdList a) + (p :: forall (x :: Type). x -> WeirdList x -> Type). + Sing wl + -> (forall (y :: Type). p _ WeirdNil) + -> (forall (z :: Type) (x :: z) (xs :: WeirdList (WeirdList z)). + Sing x -> Sing xs -> p _ xs + -> p _ (WeirdCons x xs)) + -> p _ wl +elimWeirdList SWeirdNil pWeirdNil _ = pWeirdNil +elimWeirdList (SWeirdCons (x :: Sing (x :: z)) + (xs :: Sing (xs :: WeirdList (WeirdList z)))) + pWeirdNil pWeirdCons + = pWeirdCons @z @x @xs x xs + (elimWeirdList @(WeirdList z) @xs @p xs pWeirdNil pWeirdCons) diff --git a/testsuite/tests/partial-sigs/should_fail/T14040a.stderr b/testsuite/tests/partial-sigs/should_fail/T14040a.stderr new file mode 100644 index 0000000000..20a0fa51ca --- /dev/null +++ b/testsuite/tests/partial-sigs/should_fail/T14040a.stderr @@ -0,0 +1,31 @@ + +T14040a.hs:34:8: error: + • Cannot apply expression of type ‘Sing wl + -> (forall y. p w0 'WeirdNil) + -> (forall z1 (x :: z1) (xs :: WeirdList (WeirdList z1)). + Sing x -> Sing xs -> p w1 xs -> p w2 ('WeirdCons x xs)) + -> p w3 wl’ + to a visible type argument ‘(WeirdList z)’ + • In the sixth argument of ‘pWeirdCons’, namely + ‘(elimWeirdList @(WeirdList z) @xs @p xs pWeirdNil pWeirdCons)’ + In the expression: + pWeirdCons + @z + @x + @xs + x + xs + (elimWeirdList @(WeirdList z) @xs @p xs pWeirdNil pWeirdCons) + In an equation for ‘elimWeirdList’: + elimWeirdList + (SWeirdCons (x :: Sing (x :: z)) + (xs :: Sing (xs :: WeirdList (WeirdList z)))) + pWeirdNil + pWeirdCons + = pWeirdCons + @z + @x + @xs + x + xs + (elimWeirdList @(WeirdList z) @xs @p xs pWeirdNil pWeirdCons) diff --git a/testsuite/tests/partial-sigs/should_fail/T14449.hs b/testsuite/tests/partial-sigs/should_fail/T14449.hs new file mode 100644 index 0000000000..d49a390af2 --- /dev/null +++ b/testsuite/tests/partial-sigs/should_fail/T14449.hs @@ -0,0 +1,6 @@ +{-# LANGUAGE PartialTypeSignatures #-} + +module T14449 where + +f :: a -> b -> _ +f x y = [x, y] diff --git a/testsuite/tests/partial-sigs/should_fail/T14449.stderr b/testsuite/tests/partial-sigs/should_fail/T14449.stderr new file mode 100644 index 0000000000..01e73b5edb --- /dev/null +++ b/testsuite/tests/partial-sigs/should_fail/T14449.stderr @@ -0,0 +1,4 @@ + +T14449.hs:6:1: error: + Couldn't match ‘a’ with ‘b’ + both bound by the partial type signature: f :: a -> b -> _ diff --git a/testsuite/tests/partial-sigs/should_fail/T14479.hs b/testsuite/tests/partial-sigs/should_fail/T14479.hs new file mode 100644 index 0000000000..13ee256e83 --- /dev/null +++ b/testsuite/tests/partial-sigs/should_fail/T14479.hs @@ -0,0 +1,9 @@ +{-# LANGUAGE ScopedTypeVariables, PartialTypeSignatures #-} + +module T14479 where + +foo :: Num a => a -> a +foo xxx = g xxx + where + g :: forall b. Num b => _ -> b + g y = xxx + y diff --git a/testsuite/tests/partial-sigs/should_fail/T14479.stderr b/testsuite/tests/partial-sigs/should_fail/T14479.stderr new file mode 100644 index 0000000000..84ba90a572 --- /dev/null +++ b/testsuite/tests/partial-sigs/should_fail/T14479.stderr @@ -0,0 +1,10 @@ + +T14479.hs:9:5: error: + • Can't quantify over ‘b’ + bound by the partial type signature: g :: forall b. Num b => _ -> b + • In an equation for ‘foo’: + foo xxx + = g xxx + where + g :: forall b. Num b => _ -> b + g y = xxx + y diff --git a/testsuite/tests/partial-sigs/should_fail/T14584.hs b/testsuite/tests/partial-sigs/should_fail/T14584.hs new file mode 100644 index 0000000000..1615b26205 --- /dev/null +++ b/testsuite/tests/partial-sigs/should_fail/T14584.hs @@ -0,0 +1,56 @@ +{-# OPTIONS_GHC -fdefer-type-errors #-} -- Very important to this bug! +{-# Language PartialTypeSignatures #-} +{-# Language TypeFamilyDependencies, KindSignatures #-} +{-# Language PolyKinds #-} +{-# Language DataKinds #-} +{-# Language TypeFamilies #-} +{-# Language RankNTypes #-} +{-# Language NoImplicitPrelude #-} +{-# Language FlexibleContexts #-} +{-# Language MultiParamTypeClasses #-} +{-# Language GADTs #-} +{-# Language ConstraintKinds #-} +{-# Language FlexibleInstances #-} +{-# Language TypeOperators #-} +{-# Language ScopedTypeVariables #-} +{-# Language DefaultSignatures #-} +{-# Language FunctionalDependencies #-} +{-# Language UndecidableSuperClasses #-} +{-# Language UndecidableInstances #-} +{-# Language AllowAmbiguousTypes #-} +{-# Language InstanceSigs, TypeApplications #-} + + +module T14584 where + +import Data.Monoid +import Data.Kind + +data family Sing (a::k) + +class SingKind k where + type Demote k = (res :: Type) | res -> k + fromSing :: Sing (a::k) -> Demote k + +class SingI (a::k) where + sing :: Sing a + +data ACT :: Type -> Type -> Type +data MHOM :: Type -> Type -> Type + +type m %%- a = ACT m a -> Type +type m %%-> m' = MHOM m m' -> Type + +class Monoid m => Action (act :: m %%- a) where + act :: m -> (a -> a) + +class (Monoid m, Monoid m') => MonHom (mhom :: m %%-> m') where + monHom :: m -> m' + +data MonHom_Distributive m :: (m %%- a) -> (a %%-> a) + +type Good k = (Demote k ~ k, SingKind k) + +instance (Action act, Monoid a, Good m) => MonHom (MonHom_Distributive m act :: a %%-> a) where + monHom :: a -> a + monHom = act @_ @_ @act (fromSing @m (sing @m @a :: Sing _)) diff --git a/testsuite/tests/partial-sigs/should_fail/T14584.stderr b/testsuite/tests/partial-sigs/should_fail/T14584.stderr new file mode 100644 index 0000000000..f22178774e --- /dev/null +++ b/testsuite/tests/partial-sigs/should_fail/T14584.stderr @@ -0,0 +1,64 @@ + +T14584.hs:56:41: warning: [-Wdeferred-type-errors (in -Wdefault)] + • Could not deduce: m1 ~ * + from the context: (Action act, Monoid a, Good m1) + bound by the instance declaration at T14584.hs:54:10-89 + ‘m1’ is a rigid type variable bound by + the instance declaration + at T14584.hs:54:10-89 + When matching types + a :: * + a0 :: m + Expected type: Sing a0 + Actual type: Sing a + • In the second argument of ‘fromSing’, namely + ‘(sing @m @a :: Sing _)’ + In the fourth argument of ‘act’, namely + ‘(fromSing @m (sing @m @a :: Sing _))’ + In the expression: + act @_ @_ @act (fromSing @m (sing @m @a :: Sing _)) + • Relevant bindings include + monHom :: a -> a (bound at T14584.hs:56:3) + +T14584.hs:56:41: warning: [-Wdeferred-type-errors (in -Wdefault)] + • Could not deduce: a ~~ a0 + from the context: (Action act, Monoid a, Good m1) + bound by the instance declaration at T14584.hs:54:10-89 + ‘a’ is a rigid type variable bound by + the instance declaration + at T14584.hs:54:10-89 + Expected type: Sing a0 + Actual type: Sing a + • In the second argument of ‘fromSing’, namely + ‘(sing @m @a :: Sing _)’ + In the fourth argument of ‘act’, namely + ‘(fromSing @m (sing @m @a :: Sing _))’ + In the expression: + act @_ @_ @act (fromSing @m (sing @m @a :: Sing _)) + • Relevant bindings include + monHom :: a -> a (bound at T14584.hs:56:3) + +T14584.hs:56:41: warning: [-Wdeferred-type-errors (in -Wdefault)] + • Could not deduce (SingI a) arising from a use of ‘sing’ + from the context: (Action act, Monoid a, Good m1) + bound by the instance declaration at T14584.hs:54:10-89 + • In the second argument of ‘fromSing’, namely + ‘(sing @m @a :: Sing _)’ + In the fourth argument of ‘act’, namely + ‘(fromSing @m (sing @m @a :: Sing _))’ + In the expression: + act @_ @_ @act (fromSing @m (sing @m @a :: Sing _)) + +T14584.hs:56:60: warning: [-Wpartial-type-signatures (in -Wdefault)] + • Found type wildcard ‘_’ standing for ‘a0 :: m’ + Where: ‘a0’ is an ambiguous type variable + ‘m’ is a rigid type variable bound by + the instance declaration + at T14584.hs:54:10-89 + • In an expression type signature: Sing _ + In the second argument of ‘fromSing’, namely + ‘(sing @m @a :: Sing _)’ + In the fourth argument of ‘act’, namely + ‘(fromSing @m (sing @m @a :: Sing _))’ + • Relevant bindings include + monHom :: a -> a (bound at T14584.hs:56:3) diff --git a/testsuite/tests/partial-sigs/should_fail/T14584a.hs b/testsuite/tests/partial-sigs/should_fail/T14584a.hs new file mode 100644 index 0000000000..016295ac4f --- /dev/null +++ b/testsuite/tests/partial-sigs/should_fail/T14584a.hs @@ -0,0 +1,16 @@ +{-# OPTIONS_GHC -fdefer-type-errors #-} -- Very important to this bug! +{-# Language PartialTypeSignatures #-} +{-# Language KindSignatures #-} +{-# Language PolyKinds #-} +{-# Language ScopedTypeVariables #-} +{-# Language AllowAmbiguousTypes #-} +{-# Language TypeApplications #-} + +module T14584a where + +f :: forall m. () +f = id @m :: _ + +g :: forall m. () +g = let h = id @m + in h diff --git a/testsuite/tests/partial-sigs/should_fail/T14584a.stderr b/testsuite/tests/partial-sigs/should_fail/T14584a.stderr new file mode 100644 index 0000000000..5687dcec51 --- /dev/null +++ b/testsuite/tests/partial-sigs/should_fail/T14584a.stderr @@ -0,0 +1,37 @@ + +T14584a.hs:12:5: warning: [-Wdeferred-type-errors (in -Wdefault)] + • Couldn't match expected type ‘()’ with actual type ‘m -> m’ + • In the expression: id @m :: _ + In an equation for ‘f’: f = id @m :: _ + +T14584a.hs:12:9: warning: [-Wdeferred-type-errors (in -Wdefault)] + • Expected a type, but ‘m’ has kind ‘k2’ + • In the type ‘m’ + In the expression: id @m :: _ + In an equation for ‘f’: f = id @m :: _ + +T14584a.hs:12:14: warning: [-Wpartial-type-signatures (in -Wdefault)] + • Found type wildcard ‘_’ standing for ‘m -> m’ + Where: ‘m’, ‘k’ are rigid type variables bound by + the type signature for: + f :: forall k2 (m :: k2). () + at T14584a.hs:11:1-17 + • In an expression type signature: _ + In the expression: id @m :: _ + In an equation for ‘f’: f = id @m :: _ + • Relevant bindings include f :: () (bound at T14584a.hs:12:1) + +T14584a.hs:15:17: warning: [-Wdeferred-type-errors (in -Wdefault)] + • Expected a type, but ‘m’ has kind ‘k2’ + • In the type ‘m’ + In the expression: id @m + In an equation for ‘h’: h = id @m + • Relevant bindings include h :: m -> m (bound at T14584a.hs:15:9) + +T14584a.hs:16:8: warning: [-Wdeferred-type-errors (in -Wdefault)] + • Couldn't match expected type ‘()’ with actual type ‘m -> m’ + • Probable cause: ‘h’ is applied to too few arguments + In the expression: h + In the expression: let h = id @m in h + In an equation for ‘g’: g = let h = id @m in h + • Relevant bindings include h :: m -> m (bound at T14584a.hs:15:9) diff --git a/testsuite/tests/partial-sigs/should_fail/WildcardInInstanceHead.stderr b/testsuite/tests/partial-sigs/should_fail/WildcardInInstanceHead.stderr index 9090475bc6..367e10a16f 100644 --- a/testsuite/tests/partial-sigs/should_fail/WildcardInInstanceHead.stderr +++ b/testsuite/tests/partial-sigs/should_fail/WildcardInInstanceHead.stderr @@ -1,4 +1,4 @@ WildcardInInstanceHead.hs:7:14: error: Wildcard ‘_’ not allowed - in an instance declaration for ‘Foo’ + in an instance declaration diff --git a/testsuite/tests/partial-sigs/should_fail/WildcardInStandaloneDeriving.stderr b/testsuite/tests/partial-sigs/should_fail/WildcardInStandaloneDeriving.stderr index 8e989108b1..0609021c15 100644 --- a/testsuite/tests/partial-sigs/should_fail/WildcardInStandaloneDeriving.stderr +++ b/testsuite/tests/partial-sigs/should_fail/WildcardInStandaloneDeriving.stderr @@ -1,6 +1,4 @@ -WildcardInStandaloneDeriving.hs:4:19: error: Malformed instance: _ - WildcardInStandaloneDeriving.hs:4:19: error: Wildcard ‘_’ not allowed in a deriving declaration diff --git a/testsuite/tests/partial-sigs/should_fail/WildcardInstantiations.stderr b/testsuite/tests/partial-sigs/should_fail/WildcardInstantiations.stderr index 440d8722de..aa5e8247f3 100644 --- a/testsuite/tests/partial-sigs/should_fail/WildcardInstantiations.stderr +++ b/testsuite/tests/partial-sigs/should_fail/WildcardInstantiations.stderr @@ -30,10 +30,7 @@ WildcardInstantiations.hs:8:8: error: WildcardInstantiations.hs:8:13: error: • Found type wildcard ‘_’ standing for ‘t -> w’ - Where: ‘t’ is a rigid type variable bound by - the inferred type of bar :: t -> (t -> w) -> w - at WildcardInstantiations.hs:9:1-13 - ‘w’ is a rigid type variable bound by + Where: ‘t’, ‘w’ are rigid type variables bound by the inferred type of bar :: t -> (t -> w) -> w at WildcardInstantiations.hs:9:1-13 To use the inferred type, enable PartialTypeSignatures diff --git a/testsuite/tests/partial-sigs/should_fail/all.T b/testsuite/tests/partial-sigs/should_fail/all.T index 183791868f..9866029e91 100644 --- a/testsuite/tests/partial-sigs/should_fail/all.T +++ b/testsuite/tests/partial-sigs/should_fail/all.T @@ -3,7 +3,7 @@ test('AnnotatedConstraintNotForgotten', normal, compile_fail, ['']) test('Defaulting1MROff', normal, compile, ['']) test('ExtraConstraintsWildcardInExpressionSignature', normal, compile, ['']) test('ExtraConstraintsWildcardInPatternSignature', normal, compile_fail, ['']) -test('ExtraConstraintsWildcardInPatternSplice', normal, compile_fail, ['']) +test('ExtraConstraintsWildcardInPatternSplice', [req_interp, normal], compile_fail, ['']) test('ExtraConstraintsWildcardInTypeSpliceUsed', [extra_files(['ExtraConstraintsWildcardInTypeSplice.hs']), req_interp], multimod_compile_fail, @@ -59,8 +59,16 @@ test('T10615', normal, compile_fail, ['']) test('T10045', normal, compile_fail, ['']) test('T10999', normal, compile_fail, ['']) test('T11122', normal, compile, ['']) +test('T11515', normal, compile_fail, ['']) test('T11976', normal, compile_fail, ['']) test('PatBind3', normal, compile_fail, ['']) test('T12039', normal, compile_fail, ['']) test('T12634', normal, compile_fail, ['']) test('T12732', normal, compile_fail, ['-fobject-code -fdefer-typed-holes']) +test('T13324_fail1', normal, compile_fail, ['']) +test('T13324_fail2', normal, compile_fail, ['']) +test('T14040a', normal, compile_fail, ['']) +test('T14449', normal, compile_fail, ['']) +test('T14479', normal, compile_fail, ['']) +test('T14584', normal, compile, ['']) +test('T14584a', normal, compile, ['']) diff --git a/testsuite/tests/partial-sigs/should_run/GHCiWildcardKind.script b/testsuite/tests/partial-sigs/should_run/GHCiWildcardKind.script index a3f9b3512a..08de235de0 100644 --- a/testsuite/tests/partial-sigs/should_run/GHCiWildcardKind.script +++ b/testsuite/tests/partial-sigs/should_run/GHCiWildcardKind.script @@ -1,3 +1,4 @@ +:set -XPartialTypeSignatures -fno-warn-partial-type-signatures :kind _ :kind Maybe _ diff --git a/testsuite/tests/partial-sigs/should_run/T15415.script b/testsuite/tests/partial-sigs/should_run/T15415.script new file mode 100644 index 0000000000..93a3f41b09 --- /dev/null +++ b/testsuite/tests/partial-sigs/should_run/T15415.script @@ -0,0 +1,17 @@ +import Data.Proxy +:set -XPolyKinds +data Dependent a (x :: a) + +:k Proxy _ +:k Proxy (Maybe :: _) +:k Dependent _ + +:set -XPartialTypeSignatures +:k Proxy _ +:k Proxy (Maybe :: _) +:k Dependent _ + +:set -fno-warn-partial-type-signatures +:k Proxy _ +:k Proxy (Maybe :: _) +:k Dependent _ diff --git a/testsuite/tests/partial-sigs/should_run/T15415.stderr b/testsuite/tests/partial-sigs/should_run/T15415.stderr new file mode 100644 index 0000000000..c11d54e322 --- /dev/null +++ b/testsuite/tests/partial-sigs/should_run/T15415.stderr @@ -0,0 +1,27 @@ + +<interactive>:1:7: error: + Found type wildcard ‘_’ standing for ‘w0 :: k0’ + Where: ‘w0’ is an ambiguous type variable + ‘k0’ is an ambiguous type variable + To use the inferred type, enable PartialTypeSignatures + +<interactive>:1:17: error: + Found type wildcard ‘_’ standing for ‘* -> *’ + To use the inferred type, enable PartialTypeSignatures + +<interactive>:1:11: error: + Found type wildcard ‘_’ standing for ‘w0’ + Where: ‘w0’ is an ambiguous type variable + To use the inferred type, enable PartialTypeSignatures + +<interactive>:1:7: warning: [-Wpartial-type-signatures (in -Wdefault)] + Found type wildcard ‘_’ standing for ‘w0 :: k0’ + Where: ‘w0’ is an ambiguous type variable + ‘k0’ is an ambiguous type variable + +<interactive>:1:17: warning: [-Wpartial-type-signatures (in -Wdefault)] + Found type wildcard ‘_’ standing for ‘* -> *’ + +<interactive>:1:11: warning: [-Wpartial-type-signatures (in -Wdefault)] + Found type wildcard ‘_’ standing for ‘w0’ + Where: ‘w0’ is an ambiguous type variable diff --git a/testsuite/tests/partial-sigs/should_run/T15415.stdout b/testsuite/tests/partial-sigs/should_run/T15415.stdout new file mode 100644 index 0000000000..709da2f17c --- /dev/null +++ b/testsuite/tests/partial-sigs/should_run/T15415.stdout @@ -0,0 +1,6 @@ +Proxy _ :: * +Proxy (Maybe :: _) :: * +Dependent _ :: w -> * +Proxy _ :: * +Proxy (Maybe :: _) :: * +Dependent _ :: w -> * diff --git a/testsuite/tests/partial-sigs/should_run/all.T b/testsuite/tests/partial-sigs/should_run/all.T index 0ca1b613a1..ad08f01d48 100644 --- a/testsuite/tests/partial-sigs/should_run/all.T +++ b/testsuite/tests/partial-sigs/should_run/all.T @@ -1 +1,2 @@ test('GHCiWildcardKind', normal, ghci_script, ['GHCiWildcardKind.script']) +test('T15415', normal, ghci_script, ['T15415.script']) diff --git a/testsuite/tests/patsyn/should_compile/T11213.stderr b/testsuite/tests/patsyn/should_compile/T11213.stderr index a3df05c7a2..ae8f15f4fa 100644 --- a/testsuite/tests/patsyn/should_compile/T11213.stderr +++ b/testsuite/tests/patsyn/should_compile/T11213.stderr @@ -16,24 +16,24 @@ T11213.hs:22:1: warning: [-Wmissing-pattern-synonym-signatures (in -Wall)] T11213.hs:23:1: warning: [-Wmissing-pattern-synonym-signatures (in -Wall)] Pattern synonym with no type signature: - pattern Pur :: forall a. (Num a, Eq a) => a -> [a] + pattern Pur :: forall a. (Eq a, Num a) => a -> [a] T11213.hs:24:1: warning: [-Wmissing-pattern-synonym-signatures (in -Wall)] Pattern synonym with no type signature: pattern Purp :: forall a a1. - (Num a, Eq a) => + (Eq a, Num a) => Show a1 => a -> a1 -> ([a], UnivProv a1) T11213.hs:25:1: warning: [-Wmissing-pattern-synonym-signatures (in -Wall)] Pattern synonym with no type signature: pattern Pure :: forall a. - (Num a, Eq a) => + (Eq a, Num a) => forall a1. a -> a1 -> ([a], Ex) T11213.hs:26:1: warning: [-Wmissing-pattern-synonym-signatures (in -Wall)] Pattern synonym with no type signature: pattern Purep :: forall a. - (Num a, Eq a) => + (Eq a, Num a) => forall a1. Show a1 => a -> a1 -> ([a], ExProv) T11213.hs:27:1: warning: [-Wmissing-pattern-synonym-signatures (in -Wall)] diff --git a/testsuite/tests/patsyn/should_compile/T12698.hs b/testsuite/tests/patsyn/should_compile/T12698.hs index 27d54d8eba..68cd817677 100644 --- a/testsuite/tests/patsyn/should_compile/T12698.hs +++ b/testsuite/tests/patsyn/should_compile/T12698.hs @@ -1,5 +1,5 @@ {-# Language ViewPatterns, TypeOperators, KindSignatures, PolyKinds, - TypeInType, StandaloneDeriving, GADTs, RebindableSyntax, + StandaloneDeriving, GADTs, RebindableSyntax, RankNTypes, LambdaCase, PatternSynonyms, TypeApplications #-} module T12698 where diff --git a/testsuite/tests/patsyn/should_compile/T12968.hs b/testsuite/tests/patsyn/should_compile/T12968.hs index 9d38500d67..99626df1a7 100644 --- a/testsuite/tests/patsyn/should_compile/T12968.hs +++ b/testsuite/tests/patsyn/should_compile/T12968.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE TypeInType, GADTs, ScopedTypeVariables, PatternSynonyms, +{-# LANGUAGE PolyKinds , GADTs, ScopedTypeVariables, PatternSynonyms, ViewPatterns #-} module T12968 where diff --git a/testsuite/tests/patsyn/should_compile/T13350/Makefile b/testsuite/tests/patsyn/should_compile/T13350/Makefile index ffd584a2a3..d3a42e46a9 100644 --- a/testsuite/tests/patsyn/should_compile/T13350/Makefile +++ b/testsuite/tests/patsyn/should_compile/T13350/Makefile @@ -6,7 +6,7 @@ LOCAL_PKGCONF=local.package.conf T13350: "$(GHC_PKG)" init $(LOCAL_PKGCONF) - cd boolean && "$(TEST_HC)" -v0 --make Setup.hs + cd boolean && "$(TEST_HC)" $(TEST_HC_OPTS) -v0 --make Setup.hs cd boolean && ./Setup configure -v0 --with-compiler="$(TEST_HC)" --with-hc-pkg="$(GHC_PKG)" --package-db=../$(LOCAL_PKGCONF) cd boolean && ./Setup build -v0 cd boolean && ./Setup register -v0 --inplace diff --git a/testsuite/tests/patsyn/should_compile/T13350/all.T b/testsuite/tests/patsyn/should_compile/T13350/all.T index fa63e37c6f..e8d82a7a9a 100644 --- a/testsuite/tests/patsyn/should_compile/T13350/all.T +++ b/testsuite/tests/patsyn/should_compile/T13350/all.T @@ -1,4 +1,6 @@ # Test that importing COMPLETE sets from external packages works -test('T13350', extra_files(['T13350.hs', 'boolean']), run_command, +test('T13350', + extra_files(['T13350.hs', 'boolean']), + run_command, ['$MAKE -s --no-print-directory T13350']) diff --git a/testsuite/tests/patsyn/should_compile/T13768.hs b/testsuite/tests/patsyn/should_compile/T13768.hs new file mode 100644 index 0000000000..3dc3b84e7e --- /dev/null +++ b/testsuite/tests/patsyn/should_compile/T13768.hs @@ -0,0 +1,35 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE PatternSynonyms #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE ViewPatterns #-} +module T13768 where + +import Data.Kind (Type) + +data NS (f :: k -> Type) (xs :: [k]) = NS Int + +data IsNS (f :: k -> Type) (xs :: [k]) where + IsZ :: f x -> IsNS f (x ': xs) + IsS :: NS f xs -> IsNS f (x ': xs) + +isNS :: NS f xs -> IsNS f xs +isNS = undefined + +pattern Z :: () => (xs' ~ (x ': xs)) => f x -> NS f xs' +pattern Z x <- (isNS -> IsZ x) + +pattern S :: () => (xs' ~ (x ': xs)) => NS f xs -> NS f xs' +pattern S p <- (isNS -> IsS p) + +{-# COMPLETE Z, S #-} + +data SList :: [k] -> Type where + SNil :: SList '[] + SCons :: SList (x ': xs) + +go :: SList ys -> NS f ys -> Int +go SCons (Z _) = 0 +go SCons (S _) = 1 +go SNil _ = error "inaccessible" diff --git a/testsuite/tests/patsyn/should_compile/T14058.hs b/testsuite/tests/patsyn/should_compile/T14058.hs new file mode 100644 index 0000000000..b2f7eea595 --- /dev/null +++ b/testsuite/tests/patsyn/should_compile/T14058.hs @@ -0,0 +1,7 @@ +{-# LANGUAGE DataKinds, PolyKinds #-} +module T14058 where + +import T14058a (Sing(..)) + +foo :: Sing ('[ '[] ] :: [[a]]) +foo = SCons SNil SNil diff --git a/testsuite/tests/patsyn/should_compile/T14058a.hs b/testsuite/tests/patsyn/should_compile/T14058a.hs new file mode 100644 index 0000000000..5e27846d2c --- /dev/null +++ b/testsuite/tests/patsyn/should_compile/T14058a.hs @@ -0,0 +1,20 @@ +{-# LANGUAGE GADTs #-} +{-# LANGUAGE PatternSynonyms #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE TypeOperators #-} +module T14058a (Sing(.., SCons)) where + +data family Sing (a :: k) + +data instance Sing (z :: [a]) where + SNil :: Sing '[] + (:%) :: Sing x -> Sing xs -> Sing (x:xs) + +pattern SCons :: forall a (z :: [a]). () + => forall (x :: a) (xs :: [a]). z ~ (x:xs) + => Sing x -> Sing xs -> Sing z +pattern SCons x xs = (:%) x xs +{-# COMPLETE SNil, SCons #-} diff --git a/testsuite/tests/patsyn/should_compile/T14326.hs b/testsuite/tests/patsyn/should_compile/T14326.hs new file mode 100644 index 0000000000..59a1eb46fa --- /dev/null +++ b/testsuite/tests/patsyn/should_compile/T14326.hs @@ -0,0 +1,21 @@ +{-# LANGUAGE PatternSynonyms #-} +{-# LANGUAGE ExplicitForAll #-} +{-# OPTIONS_GHC -fwarn-incomplete-patterns #-} +module T14326 where + +data E a b = L' a | R b +pattern L :: forall b a. a -> E a b +pattern L a = L' a +{-# COMPLETE L, R #-} + +testMono :: E (E Int Int) Int -> Int +testMono x = case x of + L (L _) -> 0 + L (R _) -> 1 + R _ -> 2 + +testPoly :: E (E a b) c -> Int +testPoly x = case x of + L (L _) -> 0 + L (R _) -> 1 + R _ -> 2 diff --git a/testsuite/tests/patsyn/should_compile/T14394.script b/testsuite/tests/patsyn/should_compile/T14394.script new file mode 100644 index 0000000000..208df0ca36 --- /dev/null +++ b/testsuite/tests/patsyn/should_compile/T14394.script @@ -0,0 +1,24 @@ +:set -XPatternSynonyms -XGADTs -XViewPatterns -XScopedTypeVariables + +import Data.Type.Equality + +pattern Foo = HRefl + +:info Foo + +:set -XPolyKinds + +pattern Bar = HRefl +-- Expecting no provided (* ~ *) constraint + +:info Bar + +-- This one generates two Ord a dictionaries +-- but we only need one + +data S a where { MkS :: Ord a => a -> S a } + +pattern Bam x y <- (MkS (x::a), MkS (y::a)) + +:info Bam +-- Expecting only one provided Ord constraint
\ No newline at end of file diff --git a/testsuite/tests/patsyn/should_compile/T14394.stdout b/testsuite/tests/patsyn/should_compile/T14394.stdout new file mode 100644 index 0000000000..557b8f4a74 --- /dev/null +++ b/testsuite/tests/patsyn/should_compile/T14394.stdout @@ -0,0 +1,10 @@ +pattern Foo :: () => (b ~ a) => a :~~: b + -- Defined at <interactive>:5:1 +pattern Bar + :: forall k2 k1 (a :: k1) (b :: k2). + () => + (k2 ~ k1, b ~~ a) => + a :~~: b + -- Defined at <interactive>:11:1 +pattern Bam :: () => Ord a => a -> a -> (S a, S a) + -- Defined at <interactive>:21:1 diff --git a/testsuite/tests/patsyn/should_compile/all.T b/testsuite/tests/patsyn/should_compile/all.T index 30319c7050..19c9eaafae 100644 --- a/testsuite/tests/patsyn/should_compile/all.T +++ b/testsuite/tests/patsyn/should_compile/all.T @@ -70,3 +70,8 @@ test('T13441b', normal, compile_fail, ['']) test('T13454', normal, compile, ['']) test('T13752', normal, compile, ['']) test('T13752a', normal, compile, ['']) +test('T13768', normal, compile, ['']) +test('T14058', [extra_files(['T14058.hs', 'T14058a.hs'])], + multimod_compile, ['T14058', '-v0']) +test('T14326', normal, compile, ['']) +test('T14394', normal, ghci_script, ['T14394.script']) diff --git a/testsuite/tests/patsyn/should_fail/T11010.stderr b/testsuite/tests/patsyn/should_fail/T11010.stderr index b09140c0a5..6e3aae58f5 100644 --- a/testsuite/tests/patsyn/should_fail/T11010.stderr +++ b/testsuite/tests/patsyn/should_fail/T11010.stderr @@ -3,7 +3,7 @@ T11010.hs:9:36: error: • Couldn't match type ‘a1’ with ‘Int’ ‘a1’ is a rigid type variable bound by a pattern with constructor: - Fun :: forall b a. String -> (a -> b) -> Expr a -> Expr b, + Fun :: forall a b. String -> (a -> b) -> Expr a -> Expr b, in a pattern synonym declaration at T11010.hs:9:26-36 Expected type: a -> b diff --git a/testsuite/tests/patsyn/should_fail/T11039.stderr b/testsuite/tests/patsyn/should_fail/T11039.stderr index 4783bc9fe6..14d67a2bb2 100644 --- a/testsuite/tests/patsyn/should_fail/T11039.stderr +++ b/testsuite/tests/patsyn/should_fail/T11039.stderr @@ -2,7 +2,8 @@ T11039.hs:8:15: error: • Couldn't match type ‘f’ with ‘A’ ‘f’ is a rigid type variable bound by - the signature for pattern synonym ‘Q’ at T11039.hs:7:14-38 + the signature for pattern synonym ‘Q’ + at T11039.hs:7:1-38 Expected type: f a Actual type: A a • In the pattern: A a diff --git a/testsuite/tests/patsyn/should_fail/T11265.stderr b/testsuite/tests/patsyn/should_fail/T11265.stderr index eda5d35a9d..7161c272b1 100644 --- a/testsuite/tests/patsyn/should_fail/T11265.stderr +++ b/testsuite/tests/patsyn/should_fail/T11265.stderr @@ -1,6 +1,6 @@ T11265.hs:6:12: error: • Pattern synonym ‘A’ cannot be used here - (Pattern synonyms cannot be promoted) + (pattern synonyms cannot be promoted) • In the first argument of ‘F’, namely ‘A’ In the instance declaration for ‘F A’ diff --git a/testsuite/tests/patsyn/should_fail/T11667.stderr b/testsuite/tests/patsyn/should_fail/T11667.stderr index fdd447704d..c9c00c9165 100644 --- a/testsuite/tests/patsyn/should_fail/T11667.stderr +++ b/testsuite/tests/patsyn/should_fail/T11667.stderr @@ -16,7 +16,8 @@ T11667.hs:18:28: error: arising from the "provided" constraints claimed by the signature of ‘Pat2’ ‘b’ is a rigid type variable bound by - the signature for pattern synonym ‘Pat2’ at T11667.hs:17:17-50 + the signature for pattern synonym ‘Pat2’ + at T11667.hs:17:1-50 • In the declaration for pattern synonym ‘Pat2’ • Relevant bindings include y :: b (bound at T11667.hs:18:21) diff --git a/testsuite/tests/patsyn/should_fail/T14112.hs b/testsuite/tests/patsyn/should_fail/T14112.hs new file mode 100644 index 0000000000..3e28644480 --- /dev/null +++ b/testsuite/tests/patsyn/should_fail/T14112.hs @@ -0,0 +1,5 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE PatternSynonyms #-} +module T14112 where + +pattern MyJust1 a = Just !a diff --git a/testsuite/tests/patsyn/should_fail/T14112.stderr b/testsuite/tests/patsyn/should_fail/T14112.stderr new file mode 100644 index 0000000000..bd0b9543af --- /dev/null +++ b/testsuite/tests/patsyn/should_fail/T14112.stderr @@ -0,0 +1,7 @@ + +T14112.hs:5:21: error: + Invalid right-hand side of bidirectional pattern synonym ‘MyJust1’: + Pattern ‘!a’ is not invertible + Suggestion: instead use an explicitly bidirectional pattern synonym, e.g. + pattern MyJust1 a <- Just !a where MyJust1 a = ... + RHS pattern: Just !a diff --git a/testsuite/tests/patsyn/should_fail/T14114.hs b/testsuite/tests/patsyn/should_fail/T14114.hs new file mode 100644 index 0000000000..b1fb8e6575 --- /dev/null +++ b/testsuite/tests/patsyn/should_fail/T14114.hs @@ -0,0 +1,7 @@ +{-# LANGUAGE PatternSynonyms #-} +module T14114 where + +pattern Foo1 a <- (a,a) +pattern Foo2 a = (a,a) +pattern Foo3 a <- (a,a) where + Foo3 a = (a,a) diff --git a/testsuite/tests/patsyn/should_fail/T14114.stderr b/testsuite/tests/patsyn/should_fail/T14114.stderr new file mode 100644 index 0000000000..a93b51e8f4 --- /dev/null +++ b/testsuite/tests/patsyn/should_fail/T14114.stderr @@ -0,0 +1,18 @@ + +T14114.hs:4:20: error: + • Conflicting definitions for ‘a’ + Bound at: T14114.hs:4:20 + T14114.hs:4:22 + • In a pattern synonym declaration + +T14114.hs:5:20: error: + • Conflicting definitions for ‘a’ + Bound at: T14114.hs:5:20 + T14114.hs:5:22 + • In a pattern synonym declaration + +T14114.hs:6:20: error: + • Conflicting definitions for ‘a’ + Bound at: T14114.hs:6:20 + T14114.hs:6:22 + • In a pattern synonym declaration diff --git a/testsuite/tests/patsyn/should_fail/T14380.hs b/testsuite/tests/patsyn/should_fail/T14380.hs new file mode 100644 index 0000000000..aec398590d --- /dev/null +++ b/testsuite/tests/patsyn/should_fail/T14380.hs @@ -0,0 +1,8 @@ +{-# LANGUAGE OverloadedLists #-} +{-# LANGUAGE PatternSynonyms #-} + +module T14380 where + +data Foo = Foo [Int] +pattern Bar :: Foo +pattern Bar = Foo [] diff --git a/testsuite/tests/patsyn/should_fail/T14380.stderr b/testsuite/tests/patsyn/should_fail/T14380.stderr new file mode 100644 index 0000000000..4228d2955c --- /dev/null +++ b/testsuite/tests/patsyn/should_fail/T14380.stderr @@ -0,0 +1,9 @@ + +T14380.hs:8:15: error: + Invalid right-hand side of bidirectional pattern synonym ‘Bar’: + Pattern ‘[]’ is not invertible + Suggestion: instead use an explicitly bidirectional pattern synonym, e.g. + pattern Bar <- Foo [] where Bar = ... + Reason: rebindable syntax is on. + This is fixable: add use-case to Trac #14380 + RHS pattern: Foo [] diff --git a/testsuite/tests/patsyn/should_fail/T14498.hs b/testsuite/tests/patsyn/should_fail/T14498.hs new file mode 100644 index 0000000000..0744310aee --- /dev/null +++ b/testsuite/tests/patsyn/should_fail/T14498.hs @@ -0,0 +1,32 @@ +{-# Language PatternSynonyms, ViewPatterns, GADTs, ConstraintKinds, RankNTypes, KindSignatures, PolyKinds, ScopedTypeVariables, DataKinds #-} + +module T14498 where + +import Type.Reflection +import Data.Kind + +data Dict c where Dict :: c => Dict c + +asTypeable :: TypeRep a -> Dict (Typeable a) +asTypeable rep = + withTypeable rep + Dict + +pattern Typeable :: () => Typeable a => TypeRep a +pattern Typeable <- (asTypeable -> Dict) + where Typeable = typeRep + +data N = O | S N + +type SN = (TypeRep :: N -> Type) + +pattern SO = (Typeable :: TypeRep (O::N)) + +pattern SS :: + forall (t :: k'). + () + => forall (a :: kk -> k') (n :: kk). + (t ~ a n) + => + TypeRep n -> TypeRep t +pattern SS n <- (App (Typeable :: TypeRep (a ::kk -> k')) n) diff --git a/testsuite/tests/patsyn/should_fail/T14498.stderr b/testsuite/tests/patsyn/should_fail/T14498.stderr new file mode 100644 index 0000000000..668f9a1efc --- /dev/null +++ b/testsuite/tests/patsyn/should_fail/T14498.stderr @@ -0,0 +1,8 @@ + +T14498.hs:32:48: error: + • Pattern synonym existential ‘kk’ cannot be used here + (the existential variables of a pattern synonym + signature do not scope over the pattern) + • In the kind ‘kk -> k'’ + In the first argument of ‘TypeRep’, namely ‘(a :: kk -> k')’ + In the type ‘TypeRep (a :: kk -> k')’ diff --git a/testsuite/tests/patsyn/should_fail/T14507.hs b/testsuite/tests/patsyn/should_fail/T14507.hs new file mode 100644 index 0000000000..b36425ced6 --- /dev/null +++ b/testsuite/tests/patsyn/should_fail/T14507.hs @@ -0,0 +1,21 @@ +{-# Language PatternSynonyms, ViewPatterns, GADTs, ConstraintKinds, RankNTypes, + PolyKinds, ScopedTypeVariables, DataKinds, TypeOperators, + TypeApplications, TypeFamilies, TypeFamilyDependencies #-} + +module T14507 where + +import Type.Reflection +import Data.Kind + +foo :: TypeRep a -> (Bool :~~: k, TypeRep a) +foo rep = error "urk" + +type family SING :: k -> Type where + SING = (TypeRep :: Bool -> Type) + +pattern RepN :: forall (a::kk). () => Bool~kk => SING a -> TypeRep (a::kk) +pattern RepN tr <- (foo -> ( HRefl :: Bool:~~:kk + , tr :: TypeRep (a::Bool))) + +pattern SO x <- RepN (id -> x) + diff --git a/testsuite/tests/patsyn/should_fail/T14507.stderr b/testsuite/tests/patsyn/should_fail/T14507.stderr new file mode 100644 index 0000000000..1279ec1e4e --- /dev/null +++ b/testsuite/tests/patsyn/should_fail/T14507.stderr @@ -0,0 +1,8 @@ + +T14507.hs:20:9: error: + • Iceland Jack! Iceland Jack! Stop torturing me! + Pattern-bound variable x :: TypeRep a + has a type that mentions pattern-bound coercion: co + Hint: use -fprint-explicit-coercions to see the coercions + Probable fix: add a pattern signature + • In the declaration for pattern synonym ‘SO’ diff --git a/testsuite/tests/patsyn/should_fail/T14552.hs b/testsuite/tests/patsyn/should_fail/T14552.hs new file mode 100644 index 0000000000..a4a7493530 --- /dev/null +++ b/testsuite/tests/patsyn/should_fail/T14552.hs @@ -0,0 +1,43 @@ +{-# Language RankNTypes, ViewPatterns, PatternSynonyms, TypeOperators, ScopedTypeVariables, + KindSignatures, PolyKinds, DataKinds, TypeFamilies, GADTs #-} + +module T14552 where + +import Data.Kind +import Data.Proxy + +data family Sing a + +type a --> b = (a, b) -> Type + +type family F (f::a --> b) (x::a) :: b + +newtype Limit :: (k --> Type) -> Type where + Limit :: (forall xx. Proxy xx -> F f xx) -> Limit f + +data Exp :: [Type] -> Type -> Type where + TLam :: (forall aa. Proxy aa -> Exp xs (F w aa)) + -> Exp xs (Limit w) + +pattern FOO f <- TLam (($ Proxy) -> f) + + +{- +TLam :: forall (xs::[Type]) (b::Type). -- Universal + forall k (w :: k --> Type). -- Existential + (b ~ Limit w) => + => (forall (aa :: k). Proxy aa -> Exp xs (F w aa)) + -> Exp xs b + +-} + +{- +mfoo :: Exp xs b + -> (forall k (w :: k --> Type). + (b ~ Limit w) + => Exp xs (F w aa) + -> r) + -> r +mfoo scrut k = case srcut of + TLam g -> k (g Proxy) +-} diff --git a/testsuite/tests/patsyn/should_fail/T14552.stderr b/testsuite/tests/patsyn/should_fail/T14552.stderr new file mode 100644 index 0000000000..1723b325fa --- /dev/null +++ b/testsuite/tests/patsyn/should_fail/T14552.stderr @@ -0,0 +1,9 @@ + +T14552.hs:22:9: error: + • Universal type variable ‘aa’ has existentially bound kind: + aa :: k + Existentially-bound variables: + k :: * + w :: k --> * + Probable fix: give the pattern synonym a type signature + • In the declaration for pattern synonym ‘FOO’ diff --git a/testsuite/tests/patsyn/should_fail/T15289.hs b/testsuite/tests/patsyn/should_fail/T15289.hs new file mode 100644 index 0000000000..bc9143a392 --- /dev/null +++ b/testsuite/tests/patsyn/should_fail/T15289.hs @@ -0,0 +1,5 @@ +{-# LANGUAGE PatternSynonyms #-} +{-# LANGUAGE ScopedTypeVariables #-} +module Oops where + +pattern What = True :: Maybe diff --git a/testsuite/tests/patsyn/should_fail/T15289.stderr b/testsuite/tests/patsyn/should_fail/T15289.stderr new file mode 100644 index 0000000000..952d358692 --- /dev/null +++ b/testsuite/tests/patsyn/should_fail/T15289.stderr @@ -0,0 +1,13 @@ + +T15289.hs:5:16: error: + • Couldn't match expected type ‘Maybe’ with actual type ‘Bool’ + • In the pattern: True + In the pattern: True :: Maybe + In the declaration for pattern synonym ‘What’ + +T15289.hs:5:24: error: + • Expecting one more argument to ‘Maybe’ + Expected a type, but ‘Maybe’ has kind ‘* -> *’ + • In the type ‘Maybe’ + In a pattern type signature: Maybe + In the pattern: True :: Maybe diff --git a/testsuite/tests/patsyn/should_fail/T9161-1.stderr b/testsuite/tests/patsyn/should_fail/T9161-1.stderr index 04d9b31bf7..fff6efe286 100644 --- a/testsuite/tests/patsyn/should_fail/T9161-1.stderr +++ b/testsuite/tests/patsyn/should_fail/T9161-1.stderr @@ -1,6 +1,5 @@ T9161-1.hs:6:14: error: • Pattern synonym ‘PATTERN’ cannot be used here - (Pattern synonyms cannot be promoted) - • In the type signature: - wrongLift :: PATTERN + (pattern synonyms cannot be promoted) + • In the type signature: wrongLift :: PATTERN diff --git a/testsuite/tests/patsyn/should_fail/T9161-2.stderr b/testsuite/tests/patsyn/should_fail/T9161-2.stderr index 409b922776..cc429313aa 100644 --- a/testsuite/tests/patsyn/should_fail/T9161-2.stderr +++ b/testsuite/tests/patsyn/should_fail/T9161-2.stderr @@ -1,7 +1,6 @@ T9161-2.hs:8:20: error: • Pattern synonym ‘PATTERN’ cannot be used here - (Pattern synonyms cannot be promoted) + (pattern synonyms cannot be promoted) • In the first argument of ‘Proxy’, namely ‘PATTERN’ - In the type signature: - wrongLift :: Proxy PATTERN () + In the type signature: wrongLift :: Proxy PATTERN () diff --git a/testsuite/tests/patsyn/should_fail/all.T b/testsuite/tests/patsyn/should_fail/all.T index 86ec79a50c..c029f20eb9 100644 --- a/testsuite/tests/patsyn/should_fail/all.T +++ b/testsuite/tests/patsyn/should_fail/all.T @@ -1,7 +1,7 @@ test('mono', normal, compile_fail, ['']) test('unidir', normal, compile_fail, ['']) test('local', normal, compile_fail, ['']) -test('as-pattern', normal, compile_fail, ['']) +test('as-pattern', normal, compile, ['']) test('T9161-1', normal, compile_fail, ['']) test('T9161-2', normal, compile_fail, ['']) test('T9705-1', normal, compile_fail, ['']) @@ -36,3 +36,10 @@ test('T12819', normal, compile_fail, ['']) test('UnliftedPSBind', normal, compile_fail, ['']) test('T13349', normal, compile_fail, ['']) test('T13470', normal, compile_fail, ['']) +test('T14112', normal, compile_fail, ['']) +test('T14114', normal, compile_fail, ['']) +test('T14380', normal, compile_fail, ['']) +test('T14498', normal, compile_fail, ['']) +test('T14552', normal, compile_fail, ['']) +test('T14507', normal, compile_fail, ['-dsuppress-uniques']) +test('T15289', normal, compile_fail, ['']) diff --git a/testsuite/tests/patsyn/should_fail/as-pattern.hs b/testsuite/tests/patsyn/should_fail/as-pattern.hs index 2794bed16a..f3ec9c9029 100644 --- a/testsuite/tests/patsyn/should_fail/as-pattern.hs +++ b/testsuite/tests/patsyn/should_fail/as-pattern.hs @@ -1,4 +1,5 @@ {-# LANGUAGE PatternSynonyms #-} module ShouldFail where +-- This is now ok (following GHC proposal #94) pattern P x y <- x@(Just y) diff --git a/testsuite/tests/patsyn/should_fail/as-pattern.stderr b/testsuite/tests/patsyn/should_fail/as-pattern.stderr deleted file mode 100644 index 61df61742e..0000000000 --- a/testsuite/tests/patsyn/should_fail/as-pattern.stderr +++ /dev/null @@ -1,5 +0,0 @@ - -as-pattern.hs:4:18: error: - • Pattern synonym definition cannot contain as-patterns (@): - x@(Just y) - • In the declaration for pattern synonym ‘P’ diff --git a/testsuite/tests/patsyn/should_fail/unidir.stderr b/testsuite/tests/patsyn/should_fail/unidir.stderr index 39193dffd1..ba3799d201 100644 --- a/testsuite/tests/patsyn/should_fail/unidir.stderr +++ b/testsuite/tests/patsyn/should_fail/unidir.stderr @@ -1,5 +1,7 @@ unidir.hs:4:18: error: Invalid right-hand side of bidirectional pattern synonym ‘Head’: - pattern ‘_’ is not invertible + Pattern ‘_’ is not invertible + Suggestion: instead use an explicitly bidirectional pattern synonym, e.g. + pattern Head x <- x : _ where Head x = ... RHS pattern: x : _ diff --git a/testsuite/tests/patsyn/should_run/T14228.hs b/testsuite/tests/patsyn/should_run/T14228.hs new file mode 100644 index 0000000000..18cddd26bc --- /dev/null +++ b/testsuite/tests/patsyn/should_run/T14228.hs @@ -0,0 +1,22 @@ +{-# LANGUAGE UnboxedSums #-} +{-# LANGUAGE PatternSynonyms #-} +module Main where + +type Maybe' t = (# t | () #) + +pattern Just' :: a -> Maybe' a +pattern Just' x = (# x | #) + +pattern Nothing' :: Maybe' a +pattern Nothing' = (# | () #) + +foo x = case x of + Nothing' -> putStrLn "nothing" + Just' _ -> putStrLn "just" + +main = do + putStrLn "Nothing'" + foo Nothing' + + putStrLn "Just'" + foo (Just' "hello") diff --git a/testsuite/tests/patsyn/should_run/T14228.stdout b/testsuite/tests/patsyn/should_run/T14228.stdout new file mode 100644 index 0000000000..a8ed424881 --- /dev/null +++ b/testsuite/tests/patsyn/should_run/T14228.stdout @@ -0,0 +1,4 @@ +Nothing' +nothing +Just' +just diff --git a/testsuite/tests/patsyn/should_run/all.T b/testsuite/tests/patsyn/should_run/all.T index 1498c1f2e4..57bc41fc73 100644 --- a/testsuite/tests/patsyn/should_run/all.T +++ b/testsuite/tests/patsyn/should_run/all.T @@ -14,4 +14,15 @@ test('records-run', normal, compile_and_run, ['']) test('ghci', just_ghci, ghci_script, ['ghci.script']) test('T11985', just_ghci, ghci_script, ['T11985.script']) test('T11224', normal, compile_and_run, ['']) -test('T13688', normal, multimod_compile_and_run, ['T13688', '-v0']) +# we omit profasm/profthreaded because it doesn't bring much to the table but +# introduces its share of complexity, as the test as it is fails with +# profasm: +# T13688.hs:6:13: fatal: +# Cannot load -prof objects when GHC is built with -dynamic +# To fix this, either: +# (1) Use -fexternal-interpreter, or +# (2) Build the program twice: once with -dynamic, and then +# with -prof using -osuf to set a different object file suffix. +test('T13688', omit_ways(['profasm', 'profthreaded']), multimod_compile_and_run, ['T13688', '-v0']) +# Requires UnboxedSums, which GHCi does not support. +test('T14228', omit_ways(['ghci']), compile_and_run, ['']) diff --git a/testsuite/tests/perf/compiler/T12150.hs b/testsuite/tests/perf/compiler/T12150.hs new file mode 100644 index 0000000000..a0d4ed5ce4 --- /dev/null +++ b/testsuite/tests/perf/compiler/T12150.hs @@ -0,0 +1,103 @@ +module T12150 where + +data Result a = Success a | Error String + +{- 80 guards + + ghc-7.10.3 -O : 0.3s + ghc-8.0.1 -O : 1.8s +-} + +instance Functor Result where + {-# INLINE fmap #-} + fmap | bool = f + | bool = f + | bool = f + | bool = f + | bool = f + | bool = f + | bool = f + | bool = f + | bool = f + | bool = f + + | bool = f + | bool = f + | bool = f + | bool = f + | bool = f + | bool = f + | bool = f + | bool = f + | bool = f + | bool = f + + | bool = f + | bool = f + | bool = f + | bool = f + | bool = f + | bool = f + | bool = f + | bool = f + | bool = f + | bool = f + + | bool = f + | bool = f + | bool = f + | bool = f + | bool = f + | bool = f + | bool = f + | bool = f + | bool = f + | bool = f + + | bool = f + | bool = f + | bool = f + | bool = f + | bool = f + | bool = f + | bool = f + | bool = f + | bool = f + | bool = f + + | bool = f + | bool = f + | bool = f + | bool = f + | bool = f + | bool = f + | bool = f + | bool = f + | bool = f + | bool = f + + | bool = f + | bool = f + | bool = f + | bool = f + | bool = f + | bool = f + | bool = f + | bool = f + | bool = f + | bool = f + + | bool = f + | bool = f + | bool = f + | bool = f + | bool = f + | bool = f + | bool = f + | bool = f + | bool = f + | bool = f + + where + bool = undefined + f = undefined diff --git a/testsuite/tests/perf/compiler/T12227.hs b/testsuite/tests/perf/compiler/T12227.hs index a97ff69f45..9be515f083 100644 --- a/testsuite/tests/perf/compiler/T12227.hs +++ b/testsuite/tests/perf/compiler/T12227.hs @@ -13,25 +13,26 @@ module Crash where import Data.Proxy (Proxy(..)) import Data.Type.Equality (type (==)) +import Data.Kind import GHC.Exts import GHC.Generics -data Dict :: Constraint -> * where +data Dict :: Constraint -> Type where Dict :: a => Dict a infixr 0 --> -type family (args :: [*]) --> (ret :: *) :: * +type family (args :: [Type]) --> (ret :: Type) :: Type where '[] --> ret = ret (arg ': args) --> ret = arg -> (args --> ret) -type family AllArguments (func :: *) :: [*] +type family AllArguments (func :: Type) :: [Type] where AllArguments (arg -> func) = arg ': AllArguments func AllArguments ret = '[] -type family FinalReturn (func :: *) :: * +type family FinalReturn (func :: Type) :: Type where FinalReturn (arg -> func) = FinalReturn func FinalReturn ret = ret @@ -39,11 +40,11 @@ type family FinalReturn (func :: *) :: * type IsFullFunction f = (AllArguments f --> FinalReturn f) ~ f -type family SConstructor (struct :: *) :: * +type family SConstructor (struct :: Type) :: Type where SConstructor struct = GPrependFields (Rep struct ()) '[] --> struct -type family GPrependFields (gstruct :: *) (tail :: [*]) :: [*] +type family GPrependFields (gstruct :: Type) (tail :: [Type]) :: [Type] where GPrependFields (M1 i t f p) tail = GPrependFields (f p) tail GPrependFields (K1 i c p) tail = c ': tail @@ -60,7 +61,7 @@ instance AppendFields fields1 fields2 fields r => AppendFields (f ': fields1) fields2 (f ': fields) r class Generic struct - => GoodConstructor (struct :: *) + => GoodConstructor (struct :: Type) where goodConstructor :: Proxy struct -> Dict ( IsFullFunction (SConstructor struct) @@ -79,7 +80,7 @@ instance ( Generic struct (Proxy :: Proxy struct) {-# INLINE goodConstructor #-} -class GoodConstructorEq (isEqual :: Bool) (ctor :: *) (struct :: *) +class GoodConstructorEq (isEqual :: Bool) (ctor :: Type) (struct :: Type) where goodConstructorEq :: Proxy isEqual -> Proxy ctor diff --git a/testsuite/tests/perf/compiler/T12545a.hs b/testsuite/tests/perf/compiler/T12545a.hs index 3002085499..4eceb91d02 100644 --- a/testsuite/tests/perf/compiler/T12545a.hs +++ b/testsuite/tests/perf/compiler/T12545a.hs @@ -19,6 +19,7 @@ module T12545a , ElemsOf ) where +import Data.Kind (Type) import Data.Proxy (Proxy(..)) data ElemPath = HeadElem @@ -55,4 +56,4 @@ type IsElem a l = ElemAt (JustElemPath (FindElem 'HeadElem a l)) a l class IsElem t (ElemsOf a) => ElemOf a t where -type family ElemsOf a :: [*] +type family ElemsOf a :: [Type] diff --git a/testsuite/tests/perf/compiler/T13035.hs b/testsuite/tests/perf/compiler/T13035.hs index 4c001cf3e1..b8d294def5 100644 --- a/testsuite/tests/perf/compiler/T13035.hs +++ b/testsuite/tests/perf/compiler/T13035.hs @@ -1,7 +1,10 @@ -{-# LANGUAGE PolyKinds, DataKinds, TypeOperators, TypeFamilies, GADTs, PartialTypeSignatures #-} +{-# LANGUAGE PolyKinds, DataKinds, TypeOperators, TypeFamilies, + GADTs, PartialTypeSignatures #-} module T13035 where +import Data.Kind + newtype MyAttr a b = MyAttr { _unMyAttr :: MyFun (a b) } type MyRec a b = Rec (MyAttr a) b @@ -26,9 +29,9 @@ type (a :: j1 -> j2) $ (b :: j1) = a b infixr 0 $ infixr 9 =: -data FConst (a :: *) (b :: Fields) -data FApply (a :: * -> * -> *) b c (d :: Fields) -data FMap (a :: * -> *) b (d :: Fields) +data FConst (a :: Type) (b :: Fields) +data FApply (a :: Type -> Type -> Type) b c (d :: Fields) +data FMap (a :: Type -> Type) b (d :: Fields) type instance MyFun (FConst a b) = a type instance MyFun (FApply b c d a) = b (MyFun (c a)) (MyFun (d a)) @@ -63,7 +66,7 @@ data Fields = Name | UnsaturatedFat | ServingSize -data Rec :: (u -> *) -> [u] -> * where +data Rec :: (u -> Type) -> [u] -> Type where RNil :: Rec f '[] (:&) :: !(f r) -> !(Rec f rs) -> Rec f (r ': rs) diff --git a/testsuite/tests/perf/compiler/T13035.stderr b/testsuite/tests/perf/compiler/T13035.stderr index 52836d7e3c..3dca3d71f2 100644 --- a/testsuite/tests/perf/compiler/T13035.stderr +++ b/testsuite/tests/perf/compiler/T13035.stderr @@ -1,4 +1,4 @@ -T13035.hs:141:28: warning: [-Wpartial-type-signatures (in -Wdefault)] - • Found type wildcard ‘_’ standing for ‘'['Author]’ +T13035.hs:144:28: warning: [-Wpartial-type-signatures (in -Wdefault)] + • Found type wildcard ‘_’ standing for ‘'[ 'Author] :: [Fields]’ • In the type signature: g :: MyRec RecipeFormatter _ diff --git a/testsuite/tests/perf/compiler/T14683.hs b/testsuite/tests/perf/compiler/T14683.hs new file mode 100644 index 0000000000..41146c7f70 --- /dev/null +++ b/testsuite/tests/perf/compiler/T14683.hs @@ -0,0 +1,3869 @@ +{-# OPTIONS_GHC -w #-} +{-# OPTIONS -XMagicHash -XBangPatterns #-} +module Grammar where +import qualified Data.Array as Happy_Data_Array +import qualified Data.Bits as Bits +import qualified GHC.Exts as Happy_GHC_Exts +import Control.Applicative(Applicative(..)) +import Control.Monad (ap) + +-- The token type: +data Token = TokenLet + | TokenIn + | TokenInt Int + | TokenSym String + | TokenEq + | TokenPlus + | TokenMinus + | TokenTimes + | TokenDiv + | TokenLParen + | TokenRParen + | TokenLCurl + | TokenRCurl + | TokenLRect + | TokenRRect + deriving (Eq,Show) + +-- parser produced by Happy Version 1.19.8 + +newtype HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104 = HappyAbsSyn HappyAny +type HappyAny = Happy_GHC_Exts.Any +happyIn4 :: t4 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) +happyIn4 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn4 #-} +happyOut4 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t4 +happyOut4 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut4 #-} +happyIn5 :: t5 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) +happyIn5 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn5 #-} +happyOut5 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t5 +happyOut5 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut5 #-} +happyIn6 :: t6 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) +happyIn6 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn6 #-} +happyOut6 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t6 +happyOut6 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut6 #-} +happyIn7 :: t7 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) +happyIn7 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn7 #-} +happyOut7 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t7 +happyOut7 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut7 #-} +happyIn8 :: t8 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) +happyIn8 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn8 #-} +happyOut8 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t8 +happyOut8 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut8 #-} +happyIn9 :: t9 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) +happyIn9 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn9 #-} +happyOut9 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t9 +happyOut9 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut9 #-} +happyIn10 :: t10 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) +happyIn10 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn10 #-} +happyOut10 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t10 +happyOut10 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut10 #-} +happyIn11 :: t11 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) +happyIn11 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn11 #-} +happyOut11 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t11 +happyOut11 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut11 #-} +happyIn12 :: t12 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) +happyIn12 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn12 #-} +happyOut12 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t12 +happyOut12 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut12 #-} +happyIn13 :: t13 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) +happyIn13 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn13 #-} +happyOut13 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t13 +happyOut13 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut13 #-} +happyIn14 :: t14 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) +happyIn14 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn14 #-} +happyOut14 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t14 +happyOut14 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut14 #-} +happyIn15 :: t15 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) +happyIn15 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn15 #-} +happyOut15 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t15 +happyOut15 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut15 #-} +happyIn16 :: t16 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) +happyIn16 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn16 #-} +happyOut16 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t16 +happyOut16 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut16 #-} +happyIn17 :: t17 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) +happyIn17 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn17 #-} +happyOut17 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t17 +happyOut17 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut17 #-} +happyIn18 :: t18 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) +happyIn18 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn18 #-} +happyOut18 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t18 +happyOut18 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut18 #-} +happyIn19 :: t19 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) +happyIn19 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn19 #-} +happyOut19 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t19 +happyOut19 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut19 #-} +happyIn20 :: t20 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) +happyIn20 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn20 #-} +happyOut20 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t20 +happyOut20 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut20 #-} +happyIn21 :: t21 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) +happyIn21 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn21 #-} +happyOut21 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t21 +happyOut21 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut21 #-} +happyIn22 :: t22 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) +happyIn22 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn22 #-} +happyOut22 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t22 +happyOut22 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut22 #-} +happyIn23 :: t23 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) +happyIn23 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn23 #-} +happyOut23 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t23 +happyOut23 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut23 #-} +happyIn24 :: t24 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) +happyIn24 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn24 #-} +happyOut24 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t24 +happyOut24 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut24 #-} +happyIn25 :: t25 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) +happyIn25 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn25 #-} +happyOut25 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t25 +happyOut25 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut25 #-} +happyIn26 :: t26 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) +happyIn26 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn26 #-} +happyOut26 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t26 +happyOut26 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut26 #-} +happyIn27 :: t27 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) +happyIn27 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn27 #-} +happyOut27 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t27 +happyOut27 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut27 #-} +happyIn28 :: t28 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) +happyIn28 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn28 #-} +happyOut28 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t28 +happyOut28 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut28 #-} +happyIn29 :: t29 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) +happyIn29 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn29 #-} +happyOut29 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t29 +happyOut29 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut29 #-} +happyIn30 :: t30 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) +happyIn30 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn30 #-} +happyOut30 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t30 +happyOut30 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut30 #-} +happyIn31 :: t31 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) +happyIn31 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn31 #-} +happyOut31 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t31 +happyOut31 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut31 #-} +happyIn32 :: t32 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) +happyIn32 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn32 #-} +happyOut32 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t32 +happyOut32 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut32 #-} +happyIn33 :: t33 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) +happyIn33 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn33 #-} +happyOut33 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t33 +happyOut33 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut33 #-} +happyIn34 :: t34 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) +happyIn34 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn34 #-} +happyOut34 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t34 +happyOut34 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut34 #-} +happyIn35 :: t35 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) +happyIn35 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn35 #-} +happyOut35 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t35 +happyOut35 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut35 #-} +happyIn36 :: t36 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) +happyIn36 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn36 #-} +happyOut36 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t36 +happyOut36 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut36 #-} +happyIn37 :: t37 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) +happyIn37 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn37 #-} +happyOut37 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t37 +happyOut37 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut37 #-} +happyIn38 :: t38 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) +happyIn38 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn38 #-} +happyOut38 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t38 +happyOut38 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut38 #-} +happyIn39 :: t39 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) +happyIn39 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn39 #-} +happyOut39 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t39 +happyOut39 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut39 #-} +happyIn40 :: t40 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) +happyIn40 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn40 #-} +happyOut40 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t40 +happyOut40 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut40 #-} +happyIn41 :: t41 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) +happyIn41 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn41 #-} +happyOut41 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t41 +happyOut41 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut41 #-} +happyIn42 :: t42 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) +happyIn42 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn42 #-} +happyOut42 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t42 +happyOut42 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut42 #-} +happyIn43 :: t43 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) +happyIn43 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn43 #-} +happyOut43 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t43 +happyOut43 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut43 #-} +happyIn44 :: t44 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) +happyIn44 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn44 #-} +happyOut44 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t44 +happyOut44 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut44 #-} +happyIn45 :: t45 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) +happyIn45 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn45 #-} +happyOut45 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t45 +happyOut45 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut45 #-} +happyIn46 :: t46 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) +happyIn46 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn46 #-} +happyOut46 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t46 +happyOut46 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut46 #-} +happyIn47 :: t47 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) +happyIn47 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn47 #-} +happyOut47 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t47 +happyOut47 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut47 #-} +happyIn48 :: t48 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) +happyIn48 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn48 #-} +happyOut48 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t48 +happyOut48 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut48 #-} +happyIn49 :: t49 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) +happyIn49 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn49 #-} +happyOut49 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t49 +happyOut49 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut49 #-} +happyIn50 :: t50 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) +happyIn50 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn50 #-} +happyOut50 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t50 +happyOut50 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut50 #-} +happyIn51 :: t51 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) +happyIn51 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn51 #-} +happyOut51 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t51 +happyOut51 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut51 #-} +happyIn52 :: t52 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) +happyIn52 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn52 #-} +happyOut52 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t52 +happyOut52 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut52 #-} +happyIn53 :: t53 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) +happyIn53 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn53 #-} +happyOut53 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t53 +happyOut53 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut53 #-} +happyIn54 :: t54 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) +happyIn54 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn54 #-} +happyOut54 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t54 +happyOut54 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut54 #-} +happyIn55 :: t55 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) +happyIn55 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn55 #-} +happyOut55 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t55 +happyOut55 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut55 #-} +happyIn56 :: t56 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) +happyIn56 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn56 #-} +happyOut56 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t56 +happyOut56 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut56 #-} +happyIn57 :: t57 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) +happyIn57 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn57 #-} +happyOut57 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t57 +happyOut57 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut57 #-} +happyIn58 :: t58 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) +happyIn58 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn58 #-} +happyOut58 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t58 +happyOut58 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut58 #-} +happyIn59 :: t59 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) +happyIn59 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn59 #-} +happyOut59 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t59 +happyOut59 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut59 #-} +happyIn60 :: t60 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) +happyIn60 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn60 #-} +happyOut60 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t60 +happyOut60 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut60 #-} +happyIn61 :: t61 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) +happyIn61 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn61 #-} +happyOut61 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t61 +happyOut61 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut61 #-} +happyIn62 :: t62 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) +happyIn62 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn62 #-} +happyOut62 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t62 +happyOut62 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut62 #-} +happyIn63 :: t63 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) +happyIn63 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn63 #-} +happyOut63 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t63 +happyOut63 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut63 #-} +happyIn64 :: t64 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) +happyIn64 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn64 #-} +happyOut64 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t64 +happyOut64 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut64 #-} +happyIn65 :: t65 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) +happyIn65 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn65 #-} +happyOut65 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t65 +happyOut65 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut65 #-} +happyIn66 :: t66 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) +happyIn66 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn66 #-} +happyOut66 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t66 +happyOut66 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut66 #-} +happyIn67 :: t67 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) +happyIn67 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn67 #-} +happyOut67 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t67 +happyOut67 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut67 #-} +happyIn68 :: t68 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) +happyIn68 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn68 #-} +happyOut68 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t68 +happyOut68 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut68 #-} +happyIn69 :: t69 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) +happyIn69 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn69 #-} +happyOut69 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t69 +happyOut69 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut69 #-} +happyIn70 :: t70 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) +happyIn70 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn70 #-} +happyOut70 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t70 +happyOut70 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut70 #-} +happyIn71 :: t71 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) +happyIn71 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn71 #-} +happyOut71 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t71 +happyOut71 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut71 #-} +happyIn72 :: t72 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) +happyIn72 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn72 #-} +happyOut72 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t72 +happyOut72 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut72 #-} +happyIn73 :: t73 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) +happyIn73 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn73 #-} +happyOut73 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t73 +happyOut73 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut73 #-} +happyIn74 :: t74 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) +happyIn74 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn74 #-} +happyOut74 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t74 +happyOut74 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut74 #-} +happyIn75 :: t75 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) +happyIn75 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn75 #-} +happyOut75 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t75 +happyOut75 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut75 #-} +happyIn76 :: t76 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) +happyIn76 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn76 #-} +happyOut76 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t76 +happyOut76 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut76 #-} +happyIn77 :: t77 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) +happyIn77 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn77 #-} +happyOut77 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t77 +happyOut77 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut77 #-} +happyIn78 :: t78 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) +happyIn78 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn78 #-} +happyOut78 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t78 +happyOut78 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut78 #-} +happyIn79 :: t79 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) +happyIn79 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn79 #-} +happyOut79 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t79 +happyOut79 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut79 #-} +happyIn80 :: t80 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) +happyIn80 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn80 #-} +happyOut80 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t80 +happyOut80 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut80 #-} +happyIn81 :: t81 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) +happyIn81 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn81 #-} +happyOut81 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t81 +happyOut81 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut81 #-} +happyIn82 :: t82 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) +happyIn82 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn82 #-} +happyOut82 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t82 +happyOut82 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut82 #-} +happyIn83 :: t83 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) +happyIn83 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn83 #-} +happyOut83 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t83 +happyOut83 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut83 #-} +happyIn84 :: t84 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) +happyIn84 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn84 #-} +happyOut84 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t84 +happyOut84 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut84 #-} +happyIn85 :: t85 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) +happyIn85 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn85 #-} +happyOut85 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t85 +happyOut85 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut85 #-} +happyIn86 :: t86 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) +happyIn86 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn86 #-} +happyOut86 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t86 +happyOut86 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut86 #-} +happyIn87 :: t87 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) +happyIn87 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn87 #-} +happyOut87 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t87 +happyOut87 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut87 #-} +happyIn88 :: t88 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) +happyIn88 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn88 #-} +happyOut88 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t88 +happyOut88 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut88 #-} +happyIn89 :: t89 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) +happyIn89 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn89 #-} +happyOut89 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t89 +happyOut89 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut89 #-} +happyIn90 :: t90 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) +happyIn90 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn90 #-} +happyOut90 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t90 +happyOut90 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut90 #-} +happyIn91 :: t91 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) +happyIn91 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn91 #-} +happyOut91 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t91 +happyOut91 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut91 #-} +happyIn92 :: t92 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) +happyIn92 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn92 #-} +happyOut92 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t92 +happyOut92 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut92 #-} +happyIn93 :: t93 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) +happyIn93 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn93 #-} +happyOut93 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t93 +happyOut93 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut93 #-} +happyIn94 :: t94 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) +happyIn94 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn94 #-} +happyOut94 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t94 +happyOut94 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut94 #-} +happyIn95 :: t95 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) +happyIn95 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn95 #-} +happyOut95 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t95 +happyOut95 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut95 #-} +happyIn96 :: t96 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) +happyIn96 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn96 #-} +happyOut96 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t96 +happyOut96 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut96 #-} +happyIn97 :: t97 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) +happyIn97 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn97 #-} +happyOut97 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t97 +happyOut97 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut97 #-} +happyIn98 :: t98 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) +happyIn98 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn98 #-} +happyOut98 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t98 +happyOut98 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut98 #-} +happyIn99 :: t99 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) +happyIn99 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn99 #-} +happyOut99 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t99 +happyOut99 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut99 #-} +happyIn100 :: t100 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) +happyIn100 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn100 #-} +happyOut100 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t100 +happyOut100 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut100 #-} +happyIn101 :: t101 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) +happyIn101 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn101 #-} +happyOut101 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t101 +happyOut101 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut101 #-} +happyIn102 :: t102 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) +happyIn102 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn102 #-} +happyOut102 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t102 +happyOut102 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut102 #-} +happyIn103 :: t103 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) +happyIn103 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn103 #-} +happyOut103 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t103 +happyOut103 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut103 #-} +happyIn104 :: t104 -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) +happyIn104 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyIn104 #-} +happyOut104 :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> t104 +happyOut104 x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOut104 #-} +happyInTok :: (Token) -> (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) +happyInTok x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyInTok #-} +happyOutTok :: (HappyAbsSyn t4 t5 t6 t7 t8 t9 t10 t11 t12 t13 t14 t15 t16 t17 t18 t19 t20 t21 t22 t23 t24 t25 t26 t27 t28 t29 t30 t31 t32 t33 t34 t35 t36 t37 t38 t39 t40 t41 t42 t43 t44 t45 t46 t47 t48 t49 t50 t51 t52 t53 t54 t55 t56 t57 t58 t59 t60 t61 t62 t63 t64 t65 t66 t67 t68 t69 t70 t71 t72 t73 t74 t75 t76 t77 t78 t79 t80 t81 t82 t83 t84 t85 t86 t87 t88 t89 t90 t91 t92 t93 t94 t95 t96 t97 t98 t99 t100 t101 t102 t103 t104) -> (Token) +happyOutTok x = Happy_GHC_Exts.unsafeCoerce# x +{-# INLINE happyOutTok #-} + + +happyExpList :: HappyAddr +happyExpList = HappyA# "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4d\x2a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe0\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4d\x2a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4d\x2a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4d\x2a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4d\x2a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe4\x41\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe4\x11\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe4\x05\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4d\x2a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4d\x2a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4d\x2a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4d\x2a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4d\x2a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4d\x2a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4d\x2a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4d\x2a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4d\x2a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe0\x05\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe0\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe0\x05\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe0\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe2\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4d\x2a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4d\x3a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x4d\x6a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe0\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00"# + +{-# NOINLINE happyExpListPerState #-} +happyExpListPerState st = + token_strs_expected + where token_strs = ["error","%dummy","%start_parseCalc","Exp","Rule0","Rule1","Rule2","Rule3","Rule4","Rule5","Rule6","Rule7","Rule8","Rule9","Rule10","Rule11","Rule12","Rule13","Rule14","Rule15","Rule16","Rule17","Rule18","Rule19","Rule20","Rule21","Rule22","Rule23","Rule24","Rule25","Rule26","Rule27","Rule28","Rule29","Rule30","Rule31","Rule32","Rule33","Rule34","Rule35","Rule36","Rule37","Rule38","Rule39","Rule40","Rule41","Rule42","Rule43","Rule44","Rule45","Rule46","Rule47","Rule48","Rule49","Rule50","Rule51","Rule52","Rule53","Rule54","Rule55","Rule56","Rule57","Rule58","Rule59","Rule60","Rule61","Rule62","Rule63","Rule64","Rule65","Rule66","Rule67","Rule68","Rule69","Rule70","Rule71","Rule72","Rule73","Rule74","Rule75","Rule76","Rule77","Rule78","Rule79","Rule80","Rule81","Rule82","Rule83","Rule84","Rule85","Rule86","Rule87","Rule88","Rule89","Rule90","Rule91","Rule92","Rule93","Rule94","Rule95","Rule96","Rule97","Rule98","Rule99","let","in","int","var","'='","'+'","'-'","'*'","'/'","'('","')'","'{'","'}'","'['","']'","%eof"] + bit_start = st * 120 + bit_end = (st + 1) * 120 + read_bit = readArrayBit happyExpList + bits = map read_bit [bit_start..bit_end - 1] + bits_indexed = zip bits [0..119] + token_strs_expected = concatMap f bits_indexed + f (False, _) = [] + f (True, nr) = [token_strs !! nr] + +happyActOffsets :: HappyAddr +happyActOffsets = HappyA# "\x6d\x06\x51\x06\x59\x06\xd5\x06\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x6d\x06\x6d\x06\x79\x06\x85\x06\x9b\x06\x5a\x07\xcd\x06\x5c\x07\x21\x07\x00\x00\x91\x06\x91\x06\x91\x06\x91\x06\x63\x06\x91\x06\x00\x00\x00\x00\xbf\x06\xbf\x06\x20\x07\x00\x00\x91\x06\x91\x06\xcb\x06\x00\x00\x91\x06\x91\x06\x52\x06\x00\x00\x55\x06\x00\x00\x49\x07\x61\x07\xd4\x06\x00\x00\x55\x07\x65\x07\x2a\x07\x00\x00\x51\x07\x91\x06\x2b\x07\x00\x00\x5f\x06\xd6\x06\xdc\x06\x00\x00\x50\x06\x56\x06\x58\x06\x00\x00\x67\x06\x00\x00\x6f\x06\x00\x00\x70\x06\x00\x00\xdd\x06\x00\x00\xdf\x06\x00\x00\xe1\x06\x00\x00\x2c\x07\x00\x00\x69\x07\x2d\x07\x00\x00\xe3\x06\x00\x00\xe4\x06\x00\x00\xe5\x06\x00\x00\x72\x06\x00\x00\x75\x06\x00\x00\x7f\x06\x00\x00\x87\x06\x00\x00\x88\x06\x00\x00\x8a\x06\x00\x00\xe8\x06\x00\x00\xea\x06\x00\x00\xec\x06\x00\x00\x2e\x07\x00\x00\x2f\x07\x00\x00\xf0\x06\x00\x00\xf1\x06\x00\x00\xf3\x06\x00\x00\x8d\x06\x00\x00\x97\x06\x00\x00\x9d\x06\x00\x00\xa2\x06\x00\x00\xa4\x06\x00\x00\xa5\x06\x00\x00\xf5\x06\x00\x00\xf7\x06\x00\x00\xf8\x06\x00\x00\x30\x07\x00\x00\x31\x07\x00\x00\xf9\x06\x00\x00\xfc\x06\x00\x00\xfe\x06\x00\x00\xa6\x06\x00\x00\xa8\x06\x00\x00\xaa\x06\x00\x00\xab\x06\x00\x00\xac\x06\x00\x00\xad\x06\x00\x00\x00\x07\x00\x00\x04\x07\x00\x00\x05\x07\x00\x00\x3a\x07\x00\x00\x3b\x07\x00\x00\x07\x07\x00\x00\x09\x07\x00\x00\x0b\x07\x00\x00\xaf\x06\x00\x00\xb3\x06\x00\x00\xb5\x06\x00\x00\xba\x06\x00\x00\x47\x06\x00\x00\x60\x06\x00\x00\x0c\x07\x00\x00\x11\x07\x00\x00\x13\x07\x00\x00\x3c\x07\x00\x00\x3d\x07\x00\x00\x00\x00\x00\x00\x0d\x07\x00\x00\x00\x00\x00\x00\xbc\x06\x00\x00\xbd\x06\x00\x00\x10\x07\x00\x00\x3e\x07\x00\x00\x3f\x07\x00\x00\x12\x07\x00\x00\xbe\x06\x00\x00\xc0\x06\x00\x00\x14\x07\x00\x00\x40\x07\x00\x00\x41\x07\x00\x00\x18\x07\x00\x00\xc2\x06\x00\x00\xc3\x06\x00\x00\x19\x07\x00\x00\x4a\x07\x00\x00\x4b\x07\x00\x00\x15\x07\x00\x00\xbb\x06\x00\x00\x00\x00\x00\x00\x57\x07\x00\x00\x00\x00\x00\x00"# + +happyGotoOffsets :: HappyAddr +happyGotoOffsets = HappyA# "\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x66\x00\xcb\x00\x30\x01\x95\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xfa\x01\x5f\x02\xc4\x02\x29\x03\x00\x00\x8e\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xf3\x03\x58\x04\x00\x00\x00\x00\xbd\x04\x22\x05\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x87\x05\x00\x00\x00\x00\xec\x05\x00\x00\x00\x00\x00\x00\xec\x05\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00"# + +happyAdjustOffset :: Happy_GHC_Exts.Int# -> Happy_GHC_Exts.Int# +happyAdjustOffset off = off + +happyDefActions :: HappyAddr +happyDefActions = HappyA# "\x00\x00\x00\x00\x00\x00\x00\x00\xf5\xff\xf4\xff\xf3\xff\xf2\xff\xf1\xff\xf0\xff\xef\xff\xee\xff\xed\xff\xec\xff\xeb\xff\xea\xff\xe9\xff\xe8\xff\xe7\xff\xe6\xff\xe5\xff\xe4\xff\xe3\xff\xe2\xff\xe1\xff\xe0\xff\xdf\xff\xde\xff\xdd\xff\xdc\xff\xdb\xff\xda\xff\xd9\xff\xd8\xff\xd7\xff\xd6\xff\xd5\xff\xd4\xff\xd3\xff\xd2\xff\xd1\xff\xd0\xff\xcf\xff\xce\xff\xcd\xff\xcc\xff\xcb\xff\xca\xff\xc9\xff\xc8\xff\xc7\xff\xc6\xff\xc5\xff\xc4\xff\xc3\xff\xc2\xff\xc1\xff\xc0\xff\xbf\xff\xbe\xff\xbd\xff\xbc\xff\xbb\xff\xba\xff\xb9\xff\xb8\xff\xb7\xff\xb6\xff\xb5\xff\xb4\xff\xb3\xff\xb2\xff\xb1\xff\xb0\xff\xaf\xff\xae\xff\xad\xff\xac\xff\xab\xff\xaa\xff\xa9\xff\xa8\xff\xa7\xff\xa6\xff\xa5\xff\xa4\xff\xa3\xff\xa2\xff\xa1\xff\xa0\xff\x9f\xff\x9e\xff\x9d\xff\x9c\xff\x9b\xff\x9a\xff\x99\xff\x98\xff\x97\xff\x96\xff\x95\xff\x94\xff\x93\xff\x92\xff\xf7\xff\xf6\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xf6\xff\x00\x00\xf6\xff\x00\x00\xf8\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xfa\xff\xfb\xff\xfc\xff\xfd\xff\x00\x00\xf9\xff\x00\x00\x00\x00\x00\x00\x91\xff\x00\x00\x00\x00\x00\x00\x69\xff\x00\x00\x68\xff\x00\x00\x00\x00\x00\x00\x90\xff\x00\x00\x00\x00\x00\x00\x7d\xff\x00\x00\x00\x00\x00\x00\x7c\xff\x00\x00\x00\x00\x00\x00\x8f\xff\x00\x00\x00\x00\x00\x00\x67\xff\x00\x00\x66\xff\x00\x00\x55\xff\xf7\xff\x41\xff\x00\x00\x8e\xff\x00\x00\x4b\xff\xf7\xff\x37\xff\x00\x00\x7b\xff\xfe\xff\x00\x00\x7a\xff\x00\x00\x36\xff\x00\x00\x4a\xff\x00\x00\x8d\xff\x00\x00\x40\xff\x00\x00\x54\xff\x00\x00\x65\xff\x00\x00\x64\xff\x00\x00\x53\xff\x00\x00\x3f\xff\x00\x00\x8c\xff\x00\x00\x49\xff\x00\x00\x35\xff\x00\x00\x79\xff\x00\x00\x78\xff\x00\x00\x34\xff\x00\x00\x48\xff\x00\x00\x8b\xff\x00\x00\x3e\xff\x00\x00\x52\xff\x00\x00\x63\xff\x00\x00\x62\xff\x00\x00\x51\xff\x00\x00\x3d\xff\x00\x00\x8a\xff\x00\x00\x47\xff\x00\x00\x33\xff\x00\x00\x77\xff\x00\x00\x76\xff\x00\x00\x32\xff\x00\x00\x46\xff\x00\x00\x89\xff\x00\x00\x3c\xff\x00\x00\x50\xff\x00\x00\x61\xff\x00\x00\x60\xff\x00\x00\x4f\xff\x00\x00\x3b\xff\x00\x00\x88\xff\x00\x00\x45\xff\x00\x00\x31\xff\x00\x00\x75\xff\x00\x00\x74\xff\x00\x00\x30\xff\x00\x00\x44\xff\x00\x00\x87\xff\x00\x00\x3a\xff\x00\x00\x4e\xff\x00\x00\x5f\xff\x00\x00\x5e\xff\x00\x00\x4d\xff\x00\x00\x39\xff\x00\x00\x86\xff\x00\x00\x43\xff\x00\x00\x2f\xff\x00\x00\x73\xff\x00\x00\x72\xff\x2e\xff\x42\xff\x00\x00\x85\xff\x38\xff\x4c\xff\x00\x00\x5d\xff\x00\x00\x5c\xff\x00\x00\x84\xff\x00\x00\x71\xff\x00\x00\x70\xff\x00\x00\x83\xff\x00\x00\x5b\xff\x00\x00\x5a\xff\x00\x00\x82\xff\x00\x00\x6f\xff\x00\x00\x6e\xff\x00\x00\x81\xff\x00\x00\x59\xff\x00\x00\x58\xff\x00\x00\x80\xff\x00\x00\x6d\xff\x00\x00\x6c\xff\x00\x00\x7f\xff\x00\x00\x57\xff\x56\xff\x7e\xff\x00\x00\x6b\xff\x6a\xff"# + +happyCheck :: HappyAddr +happyCheck = HappyA# "\xff\xff\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x15\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x15\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x15\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x15\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x15\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x15\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x15\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x15\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x15\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x15\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x15\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x15\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x15\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x15\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x15\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x00\x00\x01\x00\x02\x00\x03\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x15\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x01\x00\x01\x00\x03\x00\x04\x00\x03\x00\x0f\x00\x07\x00\x03\x00\x03\x00\x0a\x00\x03\x00\x0c\x00\x04\x00\x0e\x00\x0f\x00\x01\x00\x0f\x00\x03\x00\x04\x00\x0f\x00\x0f\x00\x07\x00\x0f\x00\x05\x00\x0a\x00\x03\x00\x0c\x00\x0d\x00\x0e\x00\x01\x00\x0f\x00\x03\x00\x04\x00\x03\x00\x03\x00\x07\x00\x03\x00\x0f\x00\x0a\x00\x03\x00\x0c\x00\x01\x00\x0e\x00\x03\x00\x04\x00\x0f\x00\x0f\x00\x07\x00\x0f\x00\x03\x00\x0a\x00\x0f\x00\x0c\x00\x01\x00\x0e\x00\x03\x00\x04\x00\x03\x00\x03\x00\x07\x00\x03\x00\x0f\x00\x0a\x00\x03\x00\x0c\x00\x01\x00\x0e\x00\x03\x00\x04\x00\x0f\x00\x0f\x00\x07\x00\x0f\x00\x03\x00\x0a\x00\x0f\x00\x0c\x00\x03\x00\x0e\x00\x03\x00\x06\x00\x07\x00\x08\x00\x09\x00\x03\x00\x0f\x00\x03\x00\x03\x00\x03\x00\x0f\x00\x03\x00\x0f\x00\x03\x00\x03\x00\x03\x00\x03\x00\x0f\x00\x03\x00\x0f\x00\x0f\x00\x0f\x00\x03\x00\x0f\x00\x03\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x03\x00\x0f\x00\x03\x00\x03\x00\x03\x00\x0f\x00\x03\x00\x0f\x00\x03\x00\x03\x00\x08\x00\x09\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x0f\x00\x03\x00\x0f\x00\x03\x00\x0f\x00\x0f\x00\x06\x00\x07\x00\x08\x00\x09\x00\x03\x00\x0d\x00\x03\x00\x0d\x00\x06\x00\x07\x00\x08\x00\x09\x00\x03\x00\x03\x00\x0d\x00\x03\x00\x0d\x00\x03\x00\x10\x00\x03\x00\x03\x00\x03\x00\x0d\x00\x0d\x00\x03\x00\x0d\x00\x03\x00\x0d\x00\x03\x00\x0d\x00\x0d\x00\x0d\x00\x03\x00\x03\x00\x0d\x00\x03\x00\x0d\x00\x03\x00\x0d\x00\x03\x00\x03\x00\x03\x00\x0d\x00\x0d\x00\x03\x00\x0d\x00\x03\x00\x0d\x00\x03\x00\x0d\x00\x0d\x00\x0d\x00\x03\x00\x03\x00\x0d\x00\x03\x00\x0d\x00\x03\x00\x0d\x00\x03\x00\x03\x00\x03\x00\x0d\x00\x0d\x00\x03\x00\x0d\x00\x03\x00\x0d\x00\x03\x00\x0d\x00\x0d\x00\x0d\x00\x03\x00\x03\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x0d\x00\x03\x00\x03\x00\x0d\x00\x0d\x00\x06\x00\x07\x00\x08\x00\x09\x00\x0b\x00\x0b\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x03\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x0b\x00\x03\x00\x03\x00\x06\x00\x07\x00\x08\x00\x09\x00\x02\x00\x0b\x00\x0b\x00\x0b\x00\x06\x00\x07\x00\x08\x00\x09\x00\x06\x00\x07\x00\x08\x00\x09\x00\x05\x00\x0b\x00\x05\x00\x0b\x00\xff\xff\x0a\x00\xff\xff\x0a\x00\x06\x00\x07\x00\x08\x00\x09\x00\x06\x00\x07\x00\x08\x00\x09\x00\x06\x00\x07\x00\x08\x00\x09\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff"# + +happyTable :: HappyAddr +happyTable = HappyA# "\x00\x00\x03\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x15\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x73\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x15\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x72\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x15\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x70\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x15\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x6e\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x15\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x7d\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x15\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x7c\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x15\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x7b\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x15\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x7a\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x15\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x92\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x15\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x8f\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x15\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x8e\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x15\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x8b\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x15\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x8a\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x15\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\xac\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x15\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x7b\x00\x04\x00\x05\x00\x06\x00\x07\x00\x08\x00\x09\x00\x0a\x00\x0b\x00\x0c\x00\x0d\x00\x0e\x00\x0f\x00\x10\x00\x11\x00\x12\x00\x13\x00\x14\x00\x15\x00\x16\x00\x17\x00\x18\x00\x19\x00\x1a\x00\x1b\x00\x1c\x00\x1d\x00\x1e\x00\x1f\x00\x20\x00\x21\x00\x22\x00\x23\x00\x24\x00\x25\x00\x26\x00\x27\x00\x28\x00\x29\x00\x2a\x00\x2b\x00\x2c\x00\x2d\x00\x2e\x00\x2f\x00\x30\x00\x31\x00\x32\x00\x33\x00\x34\x00\x35\x00\x36\x00\x37\x00\x38\x00\x39\x00\x3a\x00\x3b\x00\x3c\x00\x3d\x00\x3e\x00\x3f\x00\x40\x00\x41\x00\x42\x00\x43\x00\x44\x00\x45\x00\x46\x00\x47\x00\x48\x00\x49\x00\x4a\x00\x4b\x00\x4c\x00\x4d\x00\x4e\x00\x4f\x00\x50\x00\x51\x00\x52\x00\x53\x00\x54\x00\x55\x00\x56\x00\x57\x00\x58\x00\x59\x00\x5a\x00\x5b\x00\x5c\x00\x5d\x00\x5e\x00\x5f\x00\x60\x00\x61\x00\x62\x00\x63\x00\x64\x00\x65\x00\x66\x00\x67\x00\x03\x00\x03\x00\xa3\x00\x6a\x00\x89\x00\x25\x01\x6b\x00\x9d\x00\xa1\x00\x6c\x00\x9f\x00\x6d\x00\x79\x00\x6e\x00\xa4\x00\x03\x00\x8a\x00\xa9\x00\x6a\x00\x9e\x00\xa2\x00\x6b\x00\xa0\x00\x7a\x00\x6c\x00\xba\x00\x6d\x00\xaa\x00\x6e\x00\x03\x00\x24\x01\x69\x00\x6a\x00\xb8\x00\xb6\x00\x6b\x00\xc0\x00\xbb\x00\x6c\x00\xbe\x00\x6d\x00\x03\x00\x6e\x00\x69\x00\x72\x00\xb9\x00\xb7\x00\x6b\x00\xc1\x00\xbc\x00\x6c\x00\xbf\x00\x6d\x00\x03\x00\x6e\x00\x69\x00\x70\x00\xd6\x00\xd4\x00\x6b\x00\xd2\x00\xbd\x00\x6c\x00\xdc\x00\x6d\x00\x03\x00\x6e\x00\x69\x00\x6a\x00\xd7\x00\xd5\x00\x6b\x00\xd3\x00\xda\x00\x6c\x00\xdd\x00\x6d\x00\x87\x00\x6e\x00\xd8\x00\x75\x00\x76\x00\x77\x00\x78\x00\xf2\x00\xdb\x00\xf0\x00\xee\x00\xf8\x00\x88\x00\xf6\x00\xd9\x00\xf4\x00\x0e\x01\x0c\x01\x0a\x01\xf3\x00\x14\x01\xf1\x00\xef\x00\xf9\x00\x12\x01\xf7\x00\x10\x01\xf5\x00\x0f\x01\x0d\x01\x0b\x01\x26\x01\x15\x01\x28\x01\x32\x01\x34\x01\x13\x01\x3e\x01\x11\x01\x40\x01\x4a\x01\x77\x00\x78\x00\x27\x01\x4c\x01\x29\x01\x33\x01\x35\x01\x8d\x00\x3f\x01\x83\x00\x41\x01\x4b\x01\x75\x00\x76\x00\x77\x00\x78\x00\x99\x00\x8e\x00\xa7\x00\x84\x00\x75\x00\x76\x00\x77\x00\x78\x00\xa5\x00\xb4\x00\x9a\x00\xb2\x00\xa8\x00\xb0\x00\xff\xff\xc6\x00\xc4\x00\xc2\x00\xa6\x00\xb5\x00\xd0\x00\xb3\x00\xce\x00\xb1\x00\xcc\x00\xc7\x00\xc5\x00\xc3\x00\xe2\x00\xe0\x00\xd1\x00\xde\x00\xcf\x00\xec\x00\xcd\x00\xea\x00\xe8\x00\xfe\x00\xe3\x00\xe1\x00\xfc\x00\xdf\x00\xfa\x00\xed\x00\x08\x01\xeb\x00\xe9\x00\xff\x00\x06\x01\x04\x01\xfd\x00\x1a\x01\xfb\x00\x18\x01\x09\x01\x16\x01\x22\x01\x2a\x01\x07\x01\x05\x01\x30\x01\x1b\x01\x36\x01\x19\x01\x3c\x01\x17\x01\x23\x01\x2b\x01\x42\x01\x48\x01\x31\x01\x21\x01\x37\x01\x20\x01\x3d\x01\x4d\x01\x91\x00\x7f\x00\x43\x01\x49\x01\x75\x00\x76\x00\x77\x00\x78\x00\x92\x00\x80\x00\x95\x00\xab\x00\xae\x00\xc8\x00\xca\x00\xe4\x00\xe6\x00\x00\x01\x96\x00\xac\x00\xaf\x00\xc9\x00\xcb\x00\xe5\x00\xe7\x00\x01\x01\x02\x01\x1c\x01\x1e\x01\x2c\x01\x2e\x01\x38\x01\x3a\x01\x44\x01\x03\x01\x1d\x01\x1f\x01\x2d\x01\x2f\x01\x39\x01\x3b\x01\x45\x01\x46\x01\x4e\x01\x75\x00\x76\x00\x77\x00\x78\x00\x94\x00\x9c\x00\x47\x01\x4f\x01\x75\x00\x76\x00\x77\x00\x78\x00\x75\x00\x76\x00\x77\x00\x78\x00\x85\x00\x98\x00\x81\x00\x50\x01\x00\x00\x86\x00\x00\x00\x82\x00\x75\x00\x76\x00\x9b\x00\x78\x00\x75\x00\x76\x00\x97\x00\x78\x00\x75\x00\x76\x00\x77\x00\x78\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00"# + +happyReduceArr = Happy_Data_Array.array (1, 209) [ + (1 , happyReduce_1), + (2 , happyReduce_2), + (3 , happyReduce_3), + (4 , happyReduce_4), + (5 , happyReduce_5), + (6 , happyReduce_6), + (7 , happyReduce_7), + (8 , happyReduce_8), + (9 , happyReduce_9), + (10 , happyReduce_10), + (11 , happyReduce_11), + (12 , happyReduce_12), + (13 , happyReduce_13), + (14 , happyReduce_14), + (15 , happyReduce_15), + (16 , happyReduce_16), + (17 , happyReduce_17), + (18 , happyReduce_18), + (19 , happyReduce_19), + (20 , happyReduce_20), + (21 , happyReduce_21), + (22 , happyReduce_22), + (23 , happyReduce_23), + (24 , happyReduce_24), + (25 , happyReduce_25), + (26 , happyReduce_26), + (27 , happyReduce_27), + (28 , happyReduce_28), + (29 , happyReduce_29), + (30 , happyReduce_30), + (31 , happyReduce_31), + (32 , happyReduce_32), + (33 , happyReduce_33), + (34 , happyReduce_34), + (35 , happyReduce_35), + (36 , happyReduce_36), + (37 , happyReduce_37), + (38 , happyReduce_38), + (39 , happyReduce_39), + (40 , happyReduce_40), + (41 , happyReduce_41), + (42 , happyReduce_42), + (43 , happyReduce_43), + (44 , happyReduce_44), + (45 , happyReduce_45), + (46 , happyReduce_46), + (47 , happyReduce_47), + (48 , happyReduce_48), + (49 , happyReduce_49), + (50 , happyReduce_50), + (51 , happyReduce_51), + (52 , happyReduce_52), + (53 , happyReduce_53), + (54 , happyReduce_54), + (55 , happyReduce_55), + (56 , happyReduce_56), + (57 , happyReduce_57), + (58 , happyReduce_58), + (59 , happyReduce_59), + (60 , happyReduce_60), + (61 , happyReduce_61), + (62 , happyReduce_62), + (63 , happyReduce_63), + (64 , happyReduce_64), + (65 , happyReduce_65), + (66 , happyReduce_66), + (67 , happyReduce_67), + (68 , happyReduce_68), + (69 , happyReduce_69), + (70 , happyReduce_70), + (71 , happyReduce_71), + (72 , happyReduce_72), + (73 , happyReduce_73), + (74 , happyReduce_74), + (75 , happyReduce_75), + (76 , happyReduce_76), + (77 , happyReduce_77), + (78 , happyReduce_78), + (79 , happyReduce_79), + (80 , happyReduce_80), + (81 , happyReduce_81), + (82 , happyReduce_82), + (83 , happyReduce_83), + (84 , happyReduce_84), + (85 , happyReduce_85), + (86 , happyReduce_86), + (87 , happyReduce_87), + (88 , happyReduce_88), + (89 , happyReduce_89), + (90 , happyReduce_90), + (91 , happyReduce_91), + (92 , happyReduce_92), + (93 , happyReduce_93), + (94 , happyReduce_94), + (95 , happyReduce_95), + (96 , happyReduce_96), + (97 , happyReduce_97), + (98 , happyReduce_98), + (99 , happyReduce_99), + (100 , happyReduce_100), + (101 , happyReduce_101), + (102 , happyReduce_102), + (103 , happyReduce_103), + (104 , happyReduce_104), + (105 , happyReduce_105), + (106 , happyReduce_106), + (107 , happyReduce_107), + (108 , happyReduce_108), + (109 , happyReduce_109), + (110 , happyReduce_110), + (111 , happyReduce_111), + (112 , happyReduce_112), + (113 , happyReduce_113), + (114 , happyReduce_114), + (115 , happyReduce_115), + (116 , happyReduce_116), + (117 , happyReduce_117), + (118 , happyReduce_118), + (119 , happyReduce_119), + (120 , happyReduce_120), + (121 , happyReduce_121), + (122 , happyReduce_122), + (123 , happyReduce_123), + (124 , happyReduce_124), + (125 , happyReduce_125), + (126 , happyReduce_126), + (127 , happyReduce_127), + (128 , happyReduce_128), + (129 , happyReduce_129), + (130 , happyReduce_130), + (131 , happyReduce_131), + (132 , happyReduce_132), + (133 , happyReduce_133), + (134 , happyReduce_134), + (135 , happyReduce_135), + (136 , happyReduce_136), + (137 , happyReduce_137), + (138 , happyReduce_138), + (139 , happyReduce_139), + (140 , happyReduce_140), + (141 , happyReduce_141), + (142 , happyReduce_142), + (143 , happyReduce_143), + (144 , happyReduce_144), + (145 , happyReduce_145), + (146 , happyReduce_146), + (147 , happyReduce_147), + (148 , happyReduce_148), + (149 , happyReduce_149), + (150 , happyReduce_150), + (151 , happyReduce_151), + (152 , happyReduce_152), + (153 , happyReduce_153), + (154 , happyReduce_154), + (155 , happyReduce_155), + (156 , happyReduce_156), + (157 , happyReduce_157), + (158 , happyReduce_158), + (159 , happyReduce_159), + (160 , happyReduce_160), + (161 , happyReduce_161), + (162 , happyReduce_162), + (163 , happyReduce_163), + (164 , happyReduce_164), + (165 , happyReduce_165), + (166 , happyReduce_166), + (167 , happyReduce_167), + (168 , happyReduce_168), + (169 , happyReduce_169), + (170 , happyReduce_170), + (171 , happyReduce_171), + (172 , happyReduce_172), + (173 , happyReduce_173), + (174 , happyReduce_174), + (175 , happyReduce_175), + (176 , happyReduce_176), + (177 , happyReduce_177), + (178 , happyReduce_178), + (179 , happyReduce_179), + (180 , happyReduce_180), + (181 , happyReduce_181), + (182 , happyReduce_182), + (183 , happyReduce_183), + (184 , happyReduce_184), + (185 , happyReduce_185), + (186 , happyReduce_186), + (187 , happyReduce_187), + (188 , happyReduce_188), + (189 , happyReduce_189), + (190 , happyReduce_190), + (191 , happyReduce_191), + (192 , happyReduce_192), + (193 , happyReduce_193), + (194 , happyReduce_194), + (195 , happyReduce_195), + (196 , happyReduce_196), + (197 , happyReduce_197), + (198 , happyReduce_198), + (199 , happyReduce_199), + (200 , happyReduce_200), + (201 , happyReduce_201), + (202 , happyReduce_202), + (203 , happyReduce_203), + (204 , happyReduce_204), + (205 , happyReduce_205), + (206 , happyReduce_206), + (207 , happyReduce_207), + (208 , happyReduce_208), + (209 , happyReduce_209) + ] + +happy_n_terms = 17 :: Int +happy_n_nonterms = 101 :: Int + +happyReduce_1 = happyReduce 6# 0# happyReduction_1 +happyReduction_1 (happy_x_6 `HappyStk` + happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOutTok happy_x_2 of { (TokenSym happy_var_2) -> + case happyOut4 happy_x_4 of { happy_var_4 -> + case happyOut4 happy_x_6 of { happy_var_6 -> + happyIn4 + (Let happy_var_2 happy_var_4 happy_var_6 + ) `HappyStk` happyRest}}} + +happyReduce_2 = happySpecReduce_3 0# happyReduction_2 +happyReduction_2 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut4 happy_x_1 of { happy_var_1 -> + case happyOut4 happy_x_3 of { happy_var_3 -> + happyIn4 + (Plus happy_var_1 happy_var_3 + )}} + +happyReduce_3 = happySpecReduce_3 0# happyReduction_3 +happyReduction_3 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut4 happy_x_1 of { happy_var_1 -> + case happyOut4 happy_x_3 of { happy_var_3 -> + happyIn4 + (Minus happy_var_1 happy_var_3 + )}} + +happyReduce_4 = happySpecReduce_3 0# happyReduction_4 +happyReduction_4 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut4 happy_x_1 of { happy_var_1 -> + case happyOut4 happy_x_3 of { happy_var_3 -> + happyIn4 + (Times happy_var_1 happy_var_3 + )}} + +happyReduce_5 = happySpecReduce_3 0# happyReduction_5 +happyReduction_5 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut4 happy_x_1 of { happy_var_1 -> + case happyOut4 happy_x_3 of { happy_var_3 -> + happyIn4 + (Div happy_var_1 happy_var_3 + )}} + +happyReduce_6 = happySpecReduce_3 0# happyReduction_6 +happyReduction_6 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut4 happy_x_2 of { happy_var_2 -> + happyIn4 + (happy_var_2 + )} + +happyReduce_7 = happySpecReduce_2 0# happyReduction_7 +happyReduction_7 happy_x_2 + happy_x_1 + = case happyOut4 happy_x_2 of { happy_var_2 -> + happyIn4 + (Negate happy_var_2 + )} + +happyReduce_8 = happySpecReduce_1 0# happyReduction_8 +happyReduction_8 happy_x_1 + = case happyOutTok happy_x_1 of { (TokenInt happy_var_1) -> + happyIn4 + (Int happy_var_1 + )} + +happyReduce_9 = happySpecReduce_1 0# happyReduction_9 +happyReduction_9 happy_x_1 + = case happyOutTok happy_x_1 of { (TokenSym happy_var_1) -> + happyIn4 + (Var happy_var_1 + )} + +happyReduce_10 = happySpecReduce_1 0# happyReduction_10 +happyReduction_10 happy_x_1 + = case happyOut5 happy_x_1 of { happy_var_1 -> + happyIn4 + (happy_var_1 + )} + +happyReduce_11 = happySpecReduce_1 0# happyReduction_11 +happyReduction_11 happy_x_1 + = case happyOut6 happy_x_1 of { happy_var_1 -> + happyIn4 + (happy_var_1 + )} + +happyReduce_12 = happySpecReduce_1 0# happyReduction_12 +happyReduction_12 happy_x_1 + = case happyOut7 happy_x_1 of { happy_var_1 -> + happyIn4 + (happy_var_1 + )} + +happyReduce_13 = happySpecReduce_1 0# happyReduction_13 +happyReduction_13 happy_x_1 + = case happyOut8 happy_x_1 of { happy_var_1 -> + happyIn4 + (happy_var_1 + )} + +happyReduce_14 = happySpecReduce_1 0# happyReduction_14 +happyReduction_14 happy_x_1 + = case happyOut9 happy_x_1 of { happy_var_1 -> + happyIn4 + (happy_var_1 + )} + +happyReduce_15 = happySpecReduce_1 0# happyReduction_15 +happyReduction_15 happy_x_1 + = case happyOut10 happy_x_1 of { happy_var_1 -> + happyIn4 + (happy_var_1 + )} + +happyReduce_16 = happySpecReduce_1 0# happyReduction_16 +happyReduction_16 happy_x_1 + = case happyOut11 happy_x_1 of { happy_var_1 -> + happyIn4 + (happy_var_1 + )} + +happyReduce_17 = happySpecReduce_1 0# happyReduction_17 +happyReduction_17 happy_x_1 + = case happyOut12 happy_x_1 of { happy_var_1 -> + happyIn4 + (happy_var_1 + )} + +happyReduce_18 = happySpecReduce_1 0# happyReduction_18 +happyReduction_18 happy_x_1 + = case happyOut13 happy_x_1 of { happy_var_1 -> + happyIn4 + (happy_var_1 + )} + +happyReduce_19 = happySpecReduce_1 0# happyReduction_19 +happyReduction_19 happy_x_1 + = case happyOut14 happy_x_1 of { happy_var_1 -> + happyIn4 + (happy_var_1 + )} + +happyReduce_20 = happySpecReduce_1 0# happyReduction_20 +happyReduction_20 happy_x_1 + = case happyOut15 happy_x_1 of { happy_var_1 -> + happyIn4 + (happy_var_1 + )} + +happyReduce_21 = happySpecReduce_1 0# happyReduction_21 +happyReduction_21 happy_x_1 + = case happyOut16 happy_x_1 of { happy_var_1 -> + happyIn4 + (happy_var_1 + )} + +happyReduce_22 = happySpecReduce_1 0# happyReduction_22 +happyReduction_22 happy_x_1 + = case happyOut17 happy_x_1 of { happy_var_1 -> + happyIn4 + (happy_var_1 + )} + +happyReduce_23 = happySpecReduce_1 0# happyReduction_23 +happyReduction_23 happy_x_1 + = case happyOut18 happy_x_1 of { happy_var_1 -> + happyIn4 + (happy_var_1 + )} + +happyReduce_24 = happySpecReduce_1 0# happyReduction_24 +happyReduction_24 happy_x_1 + = case happyOut19 happy_x_1 of { happy_var_1 -> + happyIn4 + (happy_var_1 + )} + +happyReduce_25 = happySpecReduce_1 0# happyReduction_25 +happyReduction_25 happy_x_1 + = case happyOut20 happy_x_1 of { happy_var_1 -> + happyIn4 + (happy_var_1 + )} + +happyReduce_26 = happySpecReduce_1 0# happyReduction_26 +happyReduction_26 happy_x_1 + = case happyOut21 happy_x_1 of { happy_var_1 -> + happyIn4 + (happy_var_1 + )} + +happyReduce_27 = happySpecReduce_1 0# happyReduction_27 +happyReduction_27 happy_x_1 + = case happyOut22 happy_x_1 of { happy_var_1 -> + happyIn4 + (happy_var_1 + )} + +happyReduce_28 = happySpecReduce_1 0# happyReduction_28 +happyReduction_28 happy_x_1 + = case happyOut23 happy_x_1 of { happy_var_1 -> + happyIn4 + (happy_var_1 + )} + +happyReduce_29 = happySpecReduce_1 0# happyReduction_29 +happyReduction_29 happy_x_1 + = case happyOut24 happy_x_1 of { happy_var_1 -> + happyIn4 + (happy_var_1 + )} + +happyReduce_30 = happySpecReduce_1 0# happyReduction_30 +happyReduction_30 happy_x_1 + = case happyOut25 happy_x_1 of { happy_var_1 -> + happyIn4 + (happy_var_1 + )} + +happyReduce_31 = happySpecReduce_1 0# happyReduction_31 +happyReduction_31 happy_x_1 + = case happyOut26 happy_x_1 of { happy_var_1 -> + happyIn4 + (happy_var_1 + )} + +happyReduce_32 = happySpecReduce_1 0# happyReduction_32 +happyReduction_32 happy_x_1 + = case happyOut27 happy_x_1 of { happy_var_1 -> + happyIn4 + (happy_var_1 + )} + +happyReduce_33 = happySpecReduce_1 0# happyReduction_33 +happyReduction_33 happy_x_1 + = case happyOut28 happy_x_1 of { happy_var_1 -> + happyIn4 + (happy_var_1 + )} + +happyReduce_34 = happySpecReduce_1 0# happyReduction_34 +happyReduction_34 happy_x_1 + = case happyOut29 happy_x_1 of { happy_var_1 -> + happyIn4 + (happy_var_1 + )} + +happyReduce_35 = happySpecReduce_1 0# happyReduction_35 +happyReduction_35 happy_x_1 + = case happyOut30 happy_x_1 of { happy_var_1 -> + happyIn4 + (happy_var_1 + )} + +happyReduce_36 = happySpecReduce_1 0# happyReduction_36 +happyReduction_36 happy_x_1 + = case happyOut31 happy_x_1 of { happy_var_1 -> + happyIn4 + (happy_var_1 + )} + +happyReduce_37 = happySpecReduce_1 0# happyReduction_37 +happyReduction_37 happy_x_1 + = case happyOut32 happy_x_1 of { happy_var_1 -> + happyIn4 + (happy_var_1 + )} + +happyReduce_38 = happySpecReduce_1 0# happyReduction_38 +happyReduction_38 happy_x_1 + = case happyOut33 happy_x_1 of { happy_var_1 -> + happyIn4 + (happy_var_1 + )} + +happyReduce_39 = happySpecReduce_1 0# happyReduction_39 +happyReduction_39 happy_x_1 + = case happyOut34 happy_x_1 of { happy_var_1 -> + happyIn4 + (happy_var_1 + )} + +happyReduce_40 = happySpecReduce_1 0# happyReduction_40 +happyReduction_40 happy_x_1 + = case happyOut35 happy_x_1 of { happy_var_1 -> + happyIn4 + (happy_var_1 + )} + +happyReduce_41 = happySpecReduce_1 0# happyReduction_41 +happyReduction_41 happy_x_1 + = case happyOut36 happy_x_1 of { happy_var_1 -> + happyIn4 + (happy_var_1 + )} + +happyReduce_42 = happySpecReduce_1 0# happyReduction_42 +happyReduction_42 happy_x_1 + = case happyOut37 happy_x_1 of { happy_var_1 -> + happyIn4 + (happy_var_1 + )} + +happyReduce_43 = happySpecReduce_1 0# happyReduction_43 +happyReduction_43 happy_x_1 + = case happyOut38 happy_x_1 of { happy_var_1 -> + happyIn4 + (happy_var_1 + )} + +happyReduce_44 = happySpecReduce_1 0# happyReduction_44 +happyReduction_44 happy_x_1 + = case happyOut39 happy_x_1 of { happy_var_1 -> + happyIn4 + (happy_var_1 + )} + +happyReduce_45 = happySpecReduce_1 0# happyReduction_45 +happyReduction_45 happy_x_1 + = case happyOut40 happy_x_1 of { happy_var_1 -> + happyIn4 + (happy_var_1 + )} + +happyReduce_46 = happySpecReduce_1 0# happyReduction_46 +happyReduction_46 happy_x_1 + = case happyOut41 happy_x_1 of { happy_var_1 -> + happyIn4 + (happy_var_1 + )} + +happyReduce_47 = happySpecReduce_1 0# happyReduction_47 +happyReduction_47 happy_x_1 + = case happyOut42 happy_x_1 of { happy_var_1 -> + happyIn4 + (happy_var_1 + )} + +happyReduce_48 = happySpecReduce_1 0# happyReduction_48 +happyReduction_48 happy_x_1 + = case happyOut43 happy_x_1 of { happy_var_1 -> + happyIn4 + (happy_var_1 + )} + +happyReduce_49 = happySpecReduce_1 0# happyReduction_49 +happyReduction_49 happy_x_1 + = case happyOut44 happy_x_1 of { happy_var_1 -> + happyIn4 + (happy_var_1 + )} + +happyReduce_50 = happySpecReduce_1 0# happyReduction_50 +happyReduction_50 happy_x_1 + = case happyOut45 happy_x_1 of { happy_var_1 -> + happyIn4 + (happy_var_1 + )} + +happyReduce_51 = happySpecReduce_1 0# happyReduction_51 +happyReduction_51 happy_x_1 + = case happyOut46 happy_x_1 of { happy_var_1 -> + happyIn4 + (happy_var_1 + )} + +happyReduce_52 = happySpecReduce_1 0# happyReduction_52 +happyReduction_52 happy_x_1 + = case happyOut47 happy_x_1 of { happy_var_1 -> + happyIn4 + (happy_var_1 + )} + +happyReduce_53 = happySpecReduce_1 0# happyReduction_53 +happyReduction_53 happy_x_1 + = case happyOut48 happy_x_1 of { happy_var_1 -> + happyIn4 + (happy_var_1 + )} + +happyReduce_54 = happySpecReduce_1 0# happyReduction_54 +happyReduction_54 happy_x_1 + = case happyOut49 happy_x_1 of { happy_var_1 -> + happyIn4 + (happy_var_1 + )} + +happyReduce_55 = happySpecReduce_1 0# happyReduction_55 +happyReduction_55 happy_x_1 + = case happyOut50 happy_x_1 of { happy_var_1 -> + happyIn4 + (happy_var_1 + )} + +happyReduce_56 = happySpecReduce_1 0# happyReduction_56 +happyReduction_56 happy_x_1 + = case happyOut51 happy_x_1 of { happy_var_1 -> + happyIn4 + (happy_var_1 + )} + +happyReduce_57 = happySpecReduce_1 0# happyReduction_57 +happyReduction_57 happy_x_1 + = case happyOut52 happy_x_1 of { happy_var_1 -> + happyIn4 + (happy_var_1 + )} + +happyReduce_58 = happySpecReduce_1 0# happyReduction_58 +happyReduction_58 happy_x_1 + = case happyOut53 happy_x_1 of { happy_var_1 -> + happyIn4 + (happy_var_1 + )} + +happyReduce_59 = happySpecReduce_1 0# happyReduction_59 +happyReduction_59 happy_x_1 + = case happyOut54 happy_x_1 of { happy_var_1 -> + happyIn4 + (happy_var_1 + )} + +happyReduce_60 = happySpecReduce_1 0# happyReduction_60 +happyReduction_60 happy_x_1 + = case happyOut55 happy_x_1 of { happy_var_1 -> + happyIn4 + (happy_var_1 + )} + +happyReduce_61 = happySpecReduce_1 0# happyReduction_61 +happyReduction_61 happy_x_1 + = case happyOut56 happy_x_1 of { happy_var_1 -> + happyIn4 + (happy_var_1 + )} + +happyReduce_62 = happySpecReduce_1 0# happyReduction_62 +happyReduction_62 happy_x_1 + = case happyOut57 happy_x_1 of { happy_var_1 -> + happyIn4 + (happy_var_1 + )} + +happyReduce_63 = happySpecReduce_1 0# happyReduction_63 +happyReduction_63 happy_x_1 + = case happyOut58 happy_x_1 of { happy_var_1 -> + happyIn4 + (happy_var_1 + )} + +happyReduce_64 = happySpecReduce_1 0# happyReduction_64 +happyReduction_64 happy_x_1 + = case happyOut59 happy_x_1 of { happy_var_1 -> + happyIn4 + (happy_var_1 + )} + +happyReduce_65 = happySpecReduce_1 0# happyReduction_65 +happyReduction_65 happy_x_1 + = case happyOut60 happy_x_1 of { happy_var_1 -> + happyIn4 + (happy_var_1 + )} + +happyReduce_66 = happySpecReduce_1 0# happyReduction_66 +happyReduction_66 happy_x_1 + = case happyOut61 happy_x_1 of { happy_var_1 -> + happyIn4 + (happy_var_1 + )} + +happyReduce_67 = happySpecReduce_1 0# happyReduction_67 +happyReduction_67 happy_x_1 + = case happyOut62 happy_x_1 of { happy_var_1 -> + happyIn4 + (happy_var_1 + )} + +happyReduce_68 = happySpecReduce_1 0# happyReduction_68 +happyReduction_68 happy_x_1 + = case happyOut63 happy_x_1 of { happy_var_1 -> + happyIn4 + (happy_var_1 + )} + +happyReduce_69 = happySpecReduce_1 0# happyReduction_69 +happyReduction_69 happy_x_1 + = case happyOut64 happy_x_1 of { happy_var_1 -> + happyIn4 + (happy_var_1 + )} + +happyReduce_70 = happySpecReduce_1 0# happyReduction_70 +happyReduction_70 happy_x_1 + = case happyOut65 happy_x_1 of { happy_var_1 -> + happyIn4 + (happy_var_1 + )} + +happyReduce_71 = happySpecReduce_1 0# happyReduction_71 +happyReduction_71 happy_x_1 + = case happyOut66 happy_x_1 of { happy_var_1 -> + happyIn4 + (happy_var_1 + )} + +happyReduce_72 = happySpecReduce_1 0# happyReduction_72 +happyReduction_72 happy_x_1 + = case happyOut67 happy_x_1 of { happy_var_1 -> + happyIn4 + (happy_var_1 + )} + +happyReduce_73 = happySpecReduce_1 0# happyReduction_73 +happyReduction_73 happy_x_1 + = case happyOut68 happy_x_1 of { happy_var_1 -> + happyIn4 + (happy_var_1 + )} + +happyReduce_74 = happySpecReduce_1 0# happyReduction_74 +happyReduction_74 happy_x_1 + = case happyOut69 happy_x_1 of { happy_var_1 -> + happyIn4 + (happy_var_1 + )} + +happyReduce_75 = happySpecReduce_1 0# happyReduction_75 +happyReduction_75 happy_x_1 + = case happyOut70 happy_x_1 of { happy_var_1 -> + happyIn4 + (happy_var_1 + )} + +happyReduce_76 = happySpecReduce_1 0# happyReduction_76 +happyReduction_76 happy_x_1 + = case happyOut71 happy_x_1 of { happy_var_1 -> + happyIn4 + (happy_var_1 + )} + +happyReduce_77 = happySpecReduce_1 0# happyReduction_77 +happyReduction_77 happy_x_1 + = case happyOut72 happy_x_1 of { happy_var_1 -> + happyIn4 + (happy_var_1 + )} + +happyReduce_78 = happySpecReduce_1 0# happyReduction_78 +happyReduction_78 happy_x_1 + = case happyOut73 happy_x_1 of { happy_var_1 -> + happyIn4 + (happy_var_1 + )} + +happyReduce_79 = happySpecReduce_1 0# happyReduction_79 +happyReduction_79 happy_x_1 + = case happyOut74 happy_x_1 of { happy_var_1 -> + happyIn4 + (happy_var_1 + )} + +happyReduce_80 = happySpecReduce_1 0# happyReduction_80 +happyReduction_80 happy_x_1 + = case happyOut75 happy_x_1 of { happy_var_1 -> + happyIn4 + (happy_var_1 + )} + +happyReduce_81 = happySpecReduce_1 0# happyReduction_81 +happyReduction_81 happy_x_1 + = case happyOut76 happy_x_1 of { happy_var_1 -> + happyIn4 + (happy_var_1 + )} + +happyReduce_82 = happySpecReduce_1 0# happyReduction_82 +happyReduction_82 happy_x_1 + = case happyOut77 happy_x_1 of { happy_var_1 -> + happyIn4 + (happy_var_1 + )} + +happyReduce_83 = happySpecReduce_1 0# happyReduction_83 +happyReduction_83 happy_x_1 + = case happyOut78 happy_x_1 of { happy_var_1 -> + happyIn4 + (happy_var_1 + )} + +happyReduce_84 = happySpecReduce_1 0# happyReduction_84 +happyReduction_84 happy_x_1 + = case happyOut79 happy_x_1 of { happy_var_1 -> + happyIn4 + (happy_var_1 + )} + +happyReduce_85 = happySpecReduce_1 0# happyReduction_85 +happyReduction_85 happy_x_1 + = case happyOut80 happy_x_1 of { happy_var_1 -> + happyIn4 + (happy_var_1 + )} + +happyReduce_86 = happySpecReduce_1 0# happyReduction_86 +happyReduction_86 happy_x_1 + = case happyOut81 happy_x_1 of { happy_var_1 -> + happyIn4 + (happy_var_1 + )} + +happyReduce_87 = happySpecReduce_1 0# happyReduction_87 +happyReduction_87 happy_x_1 + = case happyOut82 happy_x_1 of { happy_var_1 -> + happyIn4 + (happy_var_1 + )} + +happyReduce_88 = happySpecReduce_1 0# happyReduction_88 +happyReduction_88 happy_x_1 + = case happyOut83 happy_x_1 of { happy_var_1 -> + happyIn4 + (happy_var_1 + )} + +happyReduce_89 = happySpecReduce_1 0# happyReduction_89 +happyReduction_89 happy_x_1 + = case happyOut84 happy_x_1 of { happy_var_1 -> + happyIn4 + (happy_var_1 + )} + +happyReduce_90 = happySpecReduce_1 0# happyReduction_90 +happyReduction_90 happy_x_1 + = case happyOut85 happy_x_1 of { happy_var_1 -> + happyIn4 + (happy_var_1 + )} + +happyReduce_91 = happySpecReduce_1 0# happyReduction_91 +happyReduction_91 happy_x_1 + = case happyOut86 happy_x_1 of { happy_var_1 -> + happyIn4 + (happy_var_1 + )} + +happyReduce_92 = happySpecReduce_1 0# happyReduction_92 +happyReduction_92 happy_x_1 + = case happyOut87 happy_x_1 of { happy_var_1 -> + happyIn4 + (happy_var_1 + )} + +happyReduce_93 = happySpecReduce_1 0# happyReduction_93 +happyReduction_93 happy_x_1 + = case happyOut88 happy_x_1 of { happy_var_1 -> + happyIn4 + (happy_var_1 + )} + +happyReduce_94 = happySpecReduce_1 0# happyReduction_94 +happyReduction_94 happy_x_1 + = case happyOut89 happy_x_1 of { happy_var_1 -> + happyIn4 + (happy_var_1 + )} + +happyReduce_95 = happySpecReduce_1 0# happyReduction_95 +happyReduction_95 happy_x_1 + = case happyOut90 happy_x_1 of { happy_var_1 -> + happyIn4 + (happy_var_1 + )} + +happyReduce_96 = happySpecReduce_1 0# happyReduction_96 +happyReduction_96 happy_x_1 + = case happyOut91 happy_x_1 of { happy_var_1 -> + happyIn4 + (happy_var_1 + )} + +happyReduce_97 = happySpecReduce_1 0# happyReduction_97 +happyReduction_97 happy_x_1 + = case happyOut92 happy_x_1 of { happy_var_1 -> + happyIn4 + (happy_var_1 + )} + +happyReduce_98 = happySpecReduce_1 0# happyReduction_98 +happyReduction_98 happy_x_1 + = case happyOut93 happy_x_1 of { happy_var_1 -> + happyIn4 + (happy_var_1 + )} + +happyReduce_99 = happySpecReduce_1 0# happyReduction_99 +happyReduction_99 happy_x_1 + = case happyOut94 happy_x_1 of { happy_var_1 -> + happyIn4 + (happy_var_1 + )} + +happyReduce_100 = happySpecReduce_1 0# happyReduction_100 +happyReduction_100 happy_x_1 + = case happyOut95 happy_x_1 of { happy_var_1 -> + happyIn4 + (happy_var_1 + )} + +happyReduce_101 = happySpecReduce_1 0# happyReduction_101 +happyReduction_101 happy_x_1 + = case happyOut96 happy_x_1 of { happy_var_1 -> + happyIn4 + (happy_var_1 + )} + +happyReduce_102 = happySpecReduce_1 0# happyReduction_102 +happyReduction_102 happy_x_1 + = case happyOut97 happy_x_1 of { happy_var_1 -> + happyIn4 + (happy_var_1 + )} + +happyReduce_103 = happySpecReduce_1 0# happyReduction_103 +happyReduction_103 happy_x_1 + = case happyOut98 happy_x_1 of { happy_var_1 -> + happyIn4 + (happy_var_1 + )} + +happyReduce_104 = happySpecReduce_1 0# happyReduction_104 +happyReduction_104 happy_x_1 + = case happyOut99 happy_x_1 of { happy_var_1 -> + happyIn4 + (happy_var_1 + )} + +happyReduce_105 = happySpecReduce_1 0# happyReduction_105 +happyReduction_105 happy_x_1 + = case happyOut100 happy_x_1 of { happy_var_1 -> + happyIn4 + (happy_var_1 + )} + +happyReduce_106 = happySpecReduce_1 0# happyReduction_106 +happyReduction_106 happy_x_1 + = case happyOut101 happy_x_1 of { happy_var_1 -> + happyIn4 + (happy_var_1 + )} + +happyReduce_107 = happySpecReduce_1 0# happyReduction_107 +happyReduction_107 happy_x_1 + = case happyOut102 happy_x_1 of { happy_var_1 -> + happyIn4 + (happy_var_1 + )} + +happyReduce_108 = happySpecReduce_1 0# happyReduction_108 +happyReduction_108 happy_x_1 + = case happyOut103 happy_x_1 of { happy_var_1 -> + happyIn4 + (happy_var_1 + )} + +happyReduce_109 = happySpecReduce_1 0# happyReduction_109 +happyReduction_109 happy_x_1 + = case happyOut104 happy_x_1 of { happy_var_1 -> + happyIn4 + (happy_var_1 + )} + +happyReduce_110 = happySpecReduce_3 1# happyReduction_110 +happyReduction_110 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut4 happy_x_2 of { happy_var_2 -> + happyIn5 + (Dummy happy_var_2 + )} + +happyReduce_111 = happyReduce 4# 2# happyReduction_111 +happyReduction_111 (happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOut4 happy_x_2 of { happy_var_2 -> + happyIn6 + (Dummy happy_var_2 + ) `HappyStk` happyRest} + +happyReduce_112 = happyReduce 5# 3# happyReduction_112 +happyReduction_112 (happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOut4 happy_x_2 of { happy_var_2 -> + happyIn7 + (Dummy happy_var_2 + ) `HappyStk` happyRest} + +happyReduce_113 = happyReduce 6# 4# happyReduction_113 +happyReduction_113 (happy_x_6 `HappyStk` + happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOut4 happy_x_2 of { happy_var_2 -> + happyIn8 + (Dummy happy_var_2 + ) `HappyStk` happyRest} + +happyReduce_114 = happyReduce 7# 5# happyReduction_114 +happyReduction_114 (happy_x_7 `HappyStk` + happy_x_6 `HappyStk` + happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOut4 happy_x_2 of { happy_var_2 -> + happyIn9 + (Dummy happy_var_2 + ) `HappyStk` happyRest} + +happyReduce_115 = happyReduce 8# 6# happyReduction_115 +happyReduction_115 (happy_x_8 `HappyStk` + happy_x_7 `HappyStk` + happy_x_6 `HappyStk` + happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOut4 happy_x_2 of { happy_var_2 -> + happyIn10 + (Dummy happy_var_2 + ) `HappyStk` happyRest} + +happyReduce_116 = happyReduce 9# 7# happyReduction_116 +happyReduction_116 (happy_x_9 `HappyStk` + happy_x_8 `HappyStk` + happy_x_7 `HappyStk` + happy_x_6 `HappyStk` + happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOut4 happy_x_2 of { happy_var_2 -> + happyIn11 + (Dummy happy_var_2 + ) `HappyStk` happyRest} + +happyReduce_117 = happyReduce 10# 8# happyReduction_117 +happyReduction_117 (happy_x_10 `HappyStk` + happy_x_9 `HappyStk` + happy_x_8 `HappyStk` + happy_x_7 `HappyStk` + happy_x_6 `HappyStk` + happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOut4 happy_x_2 of { happy_var_2 -> + happyIn12 + (Dummy happy_var_2 + ) `HappyStk` happyRest} + +happyReduce_118 = happyReduce 11# 9# happyReduction_118 +happyReduction_118 (happy_x_11 `HappyStk` + happy_x_10 `HappyStk` + happy_x_9 `HappyStk` + happy_x_8 `HappyStk` + happy_x_7 `HappyStk` + happy_x_6 `HappyStk` + happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOut4 happy_x_2 of { happy_var_2 -> + happyIn13 + (Dummy happy_var_2 + ) `HappyStk` happyRest} + +happyReduce_119 = happyReduce 12# 10# happyReduction_119 +happyReduction_119 (happy_x_12 `HappyStk` + happy_x_11 `HappyStk` + happy_x_10 `HappyStk` + happy_x_9 `HappyStk` + happy_x_8 `HappyStk` + happy_x_7 `HappyStk` + happy_x_6 `HappyStk` + happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOut4 happy_x_2 of { happy_var_2 -> + happyIn14 + (Dummy happy_var_2 + ) `HappyStk` happyRest} + +happyReduce_120 = happyReduce 13# 11# happyReduction_120 +happyReduction_120 (happy_x_13 `HappyStk` + happy_x_12 `HappyStk` + happy_x_11 `HappyStk` + happy_x_10 `HappyStk` + happy_x_9 `HappyStk` + happy_x_8 `HappyStk` + happy_x_7 `HappyStk` + happy_x_6 `HappyStk` + happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOut4 happy_x_2 of { happy_var_2 -> + happyIn15 + (Dummy happy_var_2 + ) `HappyStk` happyRest} + +happyReduce_121 = happyReduce 14# 12# happyReduction_121 +happyReduction_121 (happy_x_14 `HappyStk` + happy_x_13 `HappyStk` + happy_x_12 `HappyStk` + happy_x_11 `HappyStk` + happy_x_10 `HappyStk` + happy_x_9 `HappyStk` + happy_x_8 `HappyStk` + happy_x_7 `HappyStk` + happy_x_6 `HappyStk` + happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOut4 happy_x_2 of { happy_var_2 -> + happyIn16 + (Dummy happy_var_2 + ) `HappyStk` happyRest} + +happyReduce_122 = happyReduce 15# 13# happyReduction_122 +happyReduction_122 (happy_x_15 `HappyStk` + happy_x_14 `HappyStk` + happy_x_13 `HappyStk` + happy_x_12 `HappyStk` + happy_x_11 `HappyStk` + happy_x_10 `HappyStk` + happy_x_9 `HappyStk` + happy_x_8 `HappyStk` + happy_x_7 `HappyStk` + happy_x_6 `HappyStk` + happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOut4 happy_x_2 of { happy_var_2 -> + happyIn17 + (Dummy happy_var_2 + ) `HappyStk` happyRest} + +happyReduce_123 = happyReduce 16# 14# happyReduction_123 +happyReduction_123 (happy_x_16 `HappyStk` + happy_x_15 `HappyStk` + happy_x_14 `HappyStk` + happy_x_13 `HappyStk` + happy_x_12 `HappyStk` + happy_x_11 `HappyStk` + happy_x_10 `HappyStk` + happy_x_9 `HappyStk` + happy_x_8 `HappyStk` + happy_x_7 `HappyStk` + happy_x_6 `HappyStk` + happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOut4 happy_x_2 of { happy_var_2 -> + happyIn18 + (Dummy happy_var_2 + ) `HappyStk` happyRest} + +happyReduce_124 = happyReduce 17# 15# happyReduction_124 +happyReduction_124 (happy_x_17 `HappyStk` + happy_x_16 `HappyStk` + happy_x_15 `HappyStk` + happy_x_14 `HappyStk` + happy_x_13 `HappyStk` + happy_x_12 `HappyStk` + happy_x_11 `HappyStk` + happy_x_10 `HappyStk` + happy_x_9 `HappyStk` + happy_x_8 `HappyStk` + happy_x_7 `HappyStk` + happy_x_6 `HappyStk` + happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOut4 happy_x_2 of { happy_var_2 -> + happyIn19 + (Dummy happy_var_2 + ) `HappyStk` happyRest} + +happyReduce_125 = happyReduce 18# 16# happyReduction_125 +happyReduction_125 (happy_x_18 `HappyStk` + happy_x_17 `HappyStk` + happy_x_16 `HappyStk` + happy_x_15 `HappyStk` + happy_x_14 `HappyStk` + happy_x_13 `HappyStk` + happy_x_12 `HappyStk` + happy_x_11 `HappyStk` + happy_x_10 `HappyStk` + happy_x_9 `HappyStk` + happy_x_8 `HappyStk` + happy_x_7 `HappyStk` + happy_x_6 `HappyStk` + happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOut4 happy_x_2 of { happy_var_2 -> + happyIn20 + (Dummy happy_var_2 + ) `HappyStk` happyRest} + +happyReduce_126 = happyReduce 19# 17# happyReduction_126 +happyReduction_126 (happy_x_19 `HappyStk` + happy_x_18 `HappyStk` + happy_x_17 `HappyStk` + happy_x_16 `HappyStk` + happy_x_15 `HappyStk` + happy_x_14 `HappyStk` + happy_x_13 `HappyStk` + happy_x_12 `HappyStk` + happy_x_11 `HappyStk` + happy_x_10 `HappyStk` + happy_x_9 `HappyStk` + happy_x_8 `HappyStk` + happy_x_7 `HappyStk` + happy_x_6 `HappyStk` + happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOut4 happy_x_2 of { happy_var_2 -> + happyIn21 + (Dummy happy_var_2 + ) `HappyStk` happyRest} + +happyReduce_127 = happyReduce 20# 18# happyReduction_127 +happyReduction_127 (happy_x_20 `HappyStk` + happy_x_19 `HappyStk` + happy_x_18 `HappyStk` + happy_x_17 `HappyStk` + happy_x_16 `HappyStk` + happy_x_15 `HappyStk` + happy_x_14 `HappyStk` + happy_x_13 `HappyStk` + happy_x_12 `HappyStk` + happy_x_11 `HappyStk` + happy_x_10 `HappyStk` + happy_x_9 `HappyStk` + happy_x_8 `HappyStk` + happy_x_7 `HappyStk` + happy_x_6 `HappyStk` + happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOut4 happy_x_2 of { happy_var_2 -> + happyIn22 + (Dummy happy_var_2 + ) `HappyStk` happyRest} + +happyReduce_128 = happyReduce 21# 19# happyReduction_128 +happyReduction_128 (happy_x_21 `HappyStk` + happy_x_20 `HappyStk` + happy_x_19 `HappyStk` + happy_x_18 `HappyStk` + happy_x_17 `HappyStk` + happy_x_16 `HappyStk` + happy_x_15 `HappyStk` + happy_x_14 `HappyStk` + happy_x_13 `HappyStk` + happy_x_12 `HappyStk` + happy_x_11 `HappyStk` + happy_x_10 `HappyStk` + happy_x_9 `HappyStk` + happy_x_8 `HappyStk` + happy_x_7 `HappyStk` + happy_x_6 `HappyStk` + happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOut4 happy_x_2 of { happy_var_2 -> + happyIn23 + (Dummy happy_var_2 + ) `HappyStk` happyRest} + +happyReduce_129 = happyReduce 22# 20# happyReduction_129 +happyReduction_129 (happy_x_22 `HappyStk` + happy_x_21 `HappyStk` + happy_x_20 `HappyStk` + happy_x_19 `HappyStk` + happy_x_18 `HappyStk` + happy_x_17 `HappyStk` + happy_x_16 `HappyStk` + happy_x_15 `HappyStk` + happy_x_14 `HappyStk` + happy_x_13 `HappyStk` + happy_x_12 `HappyStk` + happy_x_11 `HappyStk` + happy_x_10 `HappyStk` + happy_x_9 `HappyStk` + happy_x_8 `HappyStk` + happy_x_7 `HappyStk` + happy_x_6 `HappyStk` + happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOut4 happy_x_2 of { happy_var_2 -> + happyIn24 + (Dummy happy_var_2 + ) `HappyStk` happyRest} + +happyReduce_130 = happyReduce 4# 21# happyReduction_130 +happyReduction_130 (happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOut4 happy_x_2 of { happy_var_2 -> + happyIn25 + (Dummy happy_var_2 + ) `HappyStk` happyRest} + +happyReduce_131 = happyReduce 5# 22# happyReduction_131 +happyReduction_131 (happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOut4 happy_x_2 of { happy_var_2 -> + happyIn26 + (Dummy happy_var_2 + ) `HappyStk` happyRest} + +happyReduce_132 = happyReduce 6# 23# happyReduction_132 +happyReduction_132 (happy_x_6 `HappyStk` + happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOut4 happy_x_2 of { happy_var_2 -> + happyIn27 + (Dummy happy_var_2 + ) `HappyStk` happyRest} + +happyReduce_133 = happyReduce 7# 24# happyReduction_133 +happyReduction_133 (happy_x_7 `HappyStk` + happy_x_6 `HappyStk` + happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOut4 happy_x_2 of { happy_var_2 -> + happyIn28 + (Dummy happy_var_2 + ) `HappyStk` happyRest} + +happyReduce_134 = happyReduce 8# 25# happyReduction_134 +happyReduction_134 (happy_x_8 `HappyStk` + happy_x_7 `HappyStk` + happy_x_6 `HappyStk` + happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOut4 happy_x_2 of { happy_var_2 -> + happyIn29 + (Dummy happy_var_2 + ) `HappyStk` happyRest} + +happyReduce_135 = happyReduce 9# 26# happyReduction_135 +happyReduction_135 (happy_x_9 `HappyStk` + happy_x_8 `HappyStk` + happy_x_7 `HappyStk` + happy_x_6 `HappyStk` + happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOut4 happy_x_2 of { happy_var_2 -> + happyIn30 + (Dummy happy_var_2 + ) `HappyStk` happyRest} + +happyReduce_136 = happyReduce 10# 27# happyReduction_136 +happyReduction_136 (happy_x_10 `HappyStk` + happy_x_9 `HappyStk` + happy_x_8 `HappyStk` + happy_x_7 `HappyStk` + happy_x_6 `HappyStk` + happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOut4 happy_x_2 of { happy_var_2 -> + happyIn31 + (Dummy happy_var_2 + ) `HappyStk` happyRest} + +happyReduce_137 = happyReduce 11# 28# happyReduction_137 +happyReduction_137 (happy_x_11 `HappyStk` + happy_x_10 `HappyStk` + happy_x_9 `HappyStk` + happy_x_8 `HappyStk` + happy_x_7 `HappyStk` + happy_x_6 `HappyStk` + happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOut4 happy_x_2 of { happy_var_2 -> + happyIn32 + (Dummy happy_var_2 + ) `HappyStk` happyRest} + +happyReduce_138 = happyReduce 12# 29# happyReduction_138 +happyReduction_138 (happy_x_12 `HappyStk` + happy_x_11 `HappyStk` + happy_x_10 `HappyStk` + happy_x_9 `HappyStk` + happy_x_8 `HappyStk` + happy_x_7 `HappyStk` + happy_x_6 `HappyStk` + happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOut4 happy_x_2 of { happy_var_2 -> + happyIn33 + (Dummy happy_var_2 + ) `HappyStk` happyRest} + +happyReduce_139 = happyReduce 13# 30# happyReduction_139 +happyReduction_139 (happy_x_13 `HappyStk` + happy_x_12 `HappyStk` + happy_x_11 `HappyStk` + happy_x_10 `HappyStk` + happy_x_9 `HappyStk` + happy_x_8 `HappyStk` + happy_x_7 `HappyStk` + happy_x_6 `HappyStk` + happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOut4 happy_x_2 of { happy_var_2 -> + happyIn34 + (Dummy happy_var_2 + ) `HappyStk` happyRest} + +happyReduce_140 = happyReduce 14# 31# happyReduction_140 +happyReduction_140 (happy_x_14 `HappyStk` + happy_x_13 `HappyStk` + happy_x_12 `HappyStk` + happy_x_11 `HappyStk` + happy_x_10 `HappyStk` + happy_x_9 `HappyStk` + happy_x_8 `HappyStk` + happy_x_7 `HappyStk` + happy_x_6 `HappyStk` + happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOut4 happy_x_2 of { happy_var_2 -> + happyIn35 + (Dummy happy_var_2 + ) `HappyStk` happyRest} + +happyReduce_141 = happyReduce 15# 32# happyReduction_141 +happyReduction_141 (happy_x_15 `HappyStk` + happy_x_14 `HappyStk` + happy_x_13 `HappyStk` + happy_x_12 `HappyStk` + happy_x_11 `HappyStk` + happy_x_10 `HappyStk` + happy_x_9 `HappyStk` + happy_x_8 `HappyStk` + happy_x_7 `HappyStk` + happy_x_6 `HappyStk` + happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOut4 happy_x_2 of { happy_var_2 -> + happyIn36 + (Dummy happy_var_2 + ) `HappyStk` happyRest} + +happyReduce_142 = happyReduce 16# 33# happyReduction_142 +happyReduction_142 (happy_x_16 `HappyStk` + happy_x_15 `HappyStk` + happy_x_14 `HappyStk` + happy_x_13 `HappyStk` + happy_x_12 `HappyStk` + happy_x_11 `HappyStk` + happy_x_10 `HappyStk` + happy_x_9 `HappyStk` + happy_x_8 `HappyStk` + happy_x_7 `HappyStk` + happy_x_6 `HappyStk` + happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOut4 happy_x_2 of { happy_var_2 -> + happyIn37 + (Dummy happy_var_2 + ) `HappyStk` happyRest} + +happyReduce_143 = happyReduce 17# 34# happyReduction_143 +happyReduction_143 (happy_x_17 `HappyStk` + happy_x_16 `HappyStk` + happy_x_15 `HappyStk` + happy_x_14 `HappyStk` + happy_x_13 `HappyStk` + happy_x_12 `HappyStk` + happy_x_11 `HappyStk` + happy_x_10 `HappyStk` + happy_x_9 `HappyStk` + happy_x_8 `HappyStk` + happy_x_7 `HappyStk` + happy_x_6 `HappyStk` + happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOut4 happy_x_2 of { happy_var_2 -> + happyIn38 + (Dummy happy_var_2 + ) `HappyStk` happyRest} + +happyReduce_144 = happyReduce 18# 35# happyReduction_144 +happyReduction_144 (happy_x_18 `HappyStk` + happy_x_17 `HappyStk` + happy_x_16 `HappyStk` + happy_x_15 `HappyStk` + happy_x_14 `HappyStk` + happy_x_13 `HappyStk` + happy_x_12 `HappyStk` + happy_x_11 `HappyStk` + happy_x_10 `HappyStk` + happy_x_9 `HappyStk` + happy_x_8 `HappyStk` + happy_x_7 `HappyStk` + happy_x_6 `HappyStk` + happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOut4 happy_x_2 of { happy_var_2 -> + happyIn39 + (Dummy happy_var_2 + ) `HappyStk` happyRest} + +happyReduce_145 = happyReduce 19# 36# happyReduction_145 +happyReduction_145 (happy_x_19 `HappyStk` + happy_x_18 `HappyStk` + happy_x_17 `HappyStk` + happy_x_16 `HappyStk` + happy_x_15 `HappyStk` + happy_x_14 `HappyStk` + happy_x_13 `HappyStk` + happy_x_12 `HappyStk` + happy_x_11 `HappyStk` + happy_x_10 `HappyStk` + happy_x_9 `HappyStk` + happy_x_8 `HappyStk` + happy_x_7 `HappyStk` + happy_x_6 `HappyStk` + happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOut4 happy_x_2 of { happy_var_2 -> + happyIn40 + (Dummy happy_var_2 + ) `HappyStk` happyRest} + +happyReduce_146 = happyReduce 20# 37# happyReduction_146 +happyReduction_146 (happy_x_20 `HappyStk` + happy_x_19 `HappyStk` + happy_x_18 `HappyStk` + happy_x_17 `HappyStk` + happy_x_16 `HappyStk` + happy_x_15 `HappyStk` + happy_x_14 `HappyStk` + happy_x_13 `HappyStk` + happy_x_12 `HappyStk` + happy_x_11 `HappyStk` + happy_x_10 `HappyStk` + happy_x_9 `HappyStk` + happy_x_8 `HappyStk` + happy_x_7 `HappyStk` + happy_x_6 `HappyStk` + happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOut4 happy_x_2 of { happy_var_2 -> + happyIn41 + (Dummy happy_var_2 + ) `HappyStk` happyRest} + +happyReduce_147 = happyReduce 21# 38# happyReduction_147 +happyReduction_147 (happy_x_21 `HappyStk` + happy_x_20 `HappyStk` + happy_x_19 `HappyStk` + happy_x_18 `HappyStk` + happy_x_17 `HappyStk` + happy_x_16 `HappyStk` + happy_x_15 `HappyStk` + happy_x_14 `HappyStk` + happy_x_13 `HappyStk` + happy_x_12 `HappyStk` + happy_x_11 `HappyStk` + happy_x_10 `HappyStk` + happy_x_9 `HappyStk` + happy_x_8 `HappyStk` + happy_x_7 `HappyStk` + happy_x_6 `HappyStk` + happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOut4 happy_x_2 of { happy_var_2 -> + happyIn42 + (Dummy happy_var_2 + ) `HappyStk` happyRest} + +happyReduce_148 = happyReduce 22# 39# happyReduction_148 +happyReduction_148 (happy_x_22 `HappyStk` + happy_x_21 `HappyStk` + happy_x_20 `HappyStk` + happy_x_19 `HappyStk` + happy_x_18 `HappyStk` + happy_x_17 `HappyStk` + happy_x_16 `HappyStk` + happy_x_15 `HappyStk` + happy_x_14 `HappyStk` + happy_x_13 `HappyStk` + happy_x_12 `HappyStk` + happy_x_11 `HappyStk` + happy_x_10 `HappyStk` + happy_x_9 `HappyStk` + happy_x_8 `HappyStk` + happy_x_7 `HappyStk` + happy_x_6 `HappyStk` + happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOut4 happy_x_2 of { happy_var_2 -> + happyIn43 + (Dummy happy_var_2 + ) `HappyStk` happyRest} + +happyReduce_149 = happyReduce 23# 40# happyReduction_149 +happyReduction_149 (happy_x_23 `HappyStk` + happy_x_22 `HappyStk` + happy_x_21 `HappyStk` + happy_x_20 `HappyStk` + happy_x_19 `HappyStk` + happy_x_18 `HappyStk` + happy_x_17 `HappyStk` + happy_x_16 `HappyStk` + happy_x_15 `HappyStk` + happy_x_14 `HappyStk` + happy_x_13 `HappyStk` + happy_x_12 `HappyStk` + happy_x_11 `HappyStk` + happy_x_10 `HappyStk` + happy_x_9 `HappyStk` + happy_x_8 `HappyStk` + happy_x_7 `HappyStk` + happy_x_6 `HappyStk` + happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOut4 happy_x_2 of { happy_var_2 -> + happyIn44 + (Dummy happy_var_2 + ) `HappyStk` happyRest} + +happyReduce_150 = happySpecReduce_3 41# happyReduction_150 +happyReduction_150 happy_x_3 + happy_x_2 + happy_x_1 + = case happyOut4 happy_x_2 of { happy_var_2 -> + happyIn45 + (Dummy happy_var_2 + )} + +happyReduce_151 = happyReduce 4# 42# happyReduction_151 +happyReduction_151 (happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOut4 happy_x_2 of { happy_var_2 -> + happyIn46 + (Dummy happy_var_2 + ) `HappyStk` happyRest} + +happyReduce_152 = happyReduce 5# 43# happyReduction_152 +happyReduction_152 (happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOut4 happy_x_2 of { happy_var_2 -> + happyIn47 + (Dummy happy_var_2 + ) `HappyStk` happyRest} + +happyReduce_153 = happyReduce 6# 44# happyReduction_153 +happyReduction_153 (happy_x_6 `HappyStk` + happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOut4 happy_x_2 of { happy_var_2 -> + happyIn48 + (Dummy happy_var_2 + ) `HappyStk` happyRest} + +happyReduce_154 = happyReduce 7# 45# happyReduction_154 +happyReduction_154 (happy_x_7 `HappyStk` + happy_x_6 `HappyStk` + happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOut4 happy_x_2 of { happy_var_2 -> + happyIn49 + (Dummy happy_var_2 + ) `HappyStk` happyRest} + +happyReduce_155 = happyReduce 8# 46# happyReduction_155 +happyReduction_155 (happy_x_8 `HappyStk` + happy_x_7 `HappyStk` + happy_x_6 `HappyStk` + happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOut4 happy_x_2 of { happy_var_2 -> + happyIn50 + (Dummy happy_var_2 + ) `HappyStk` happyRest} + +happyReduce_156 = happyReduce 9# 47# happyReduction_156 +happyReduction_156 (happy_x_9 `HappyStk` + happy_x_8 `HappyStk` + happy_x_7 `HappyStk` + happy_x_6 `HappyStk` + happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOut4 happy_x_2 of { happy_var_2 -> + happyIn51 + (Dummy happy_var_2 + ) `HappyStk` happyRest} + +happyReduce_157 = happyReduce 10# 48# happyReduction_157 +happyReduction_157 (happy_x_10 `HappyStk` + happy_x_9 `HappyStk` + happy_x_8 `HappyStk` + happy_x_7 `HappyStk` + happy_x_6 `HappyStk` + happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOut4 happy_x_2 of { happy_var_2 -> + happyIn52 + (Dummy happy_var_2 + ) `HappyStk` happyRest} + +happyReduce_158 = happyReduce 11# 49# happyReduction_158 +happyReduction_158 (happy_x_11 `HappyStk` + happy_x_10 `HappyStk` + happy_x_9 `HappyStk` + happy_x_8 `HappyStk` + happy_x_7 `HappyStk` + happy_x_6 `HappyStk` + happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOut4 happy_x_2 of { happy_var_2 -> + happyIn53 + (Dummy happy_var_2 + ) `HappyStk` happyRest} + +happyReduce_159 = happyReduce 12# 50# happyReduction_159 +happyReduction_159 (happy_x_12 `HappyStk` + happy_x_11 `HappyStk` + happy_x_10 `HappyStk` + happy_x_9 `HappyStk` + happy_x_8 `HappyStk` + happy_x_7 `HappyStk` + happy_x_6 `HappyStk` + happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOut4 happy_x_2 of { happy_var_2 -> + happyIn54 + (Dummy happy_var_2 + ) `HappyStk` happyRest} + +happyReduce_160 = happyReduce 13# 51# happyReduction_160 +happyReduction_160 (happy_x_13 `HappyStk` + happy_x_12 `HappyStk` + happy_x_11 `HappyStk` + happy_x_10 `HappyStk` + happy_x_9 `HappyStk` + happy_x_8 `HappyStk` + happy_x_7 `HappyStk` + happy_x_6 `HappyStk` + happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOut4 happy_x_2 of { happy_var_2 -> + happyIn55 + (Dummy happy_var_2 + ) `HappyStk` happyRest} + +happyReduce_161 = happyReduce 14# 52# happyReduction_161 +happyReduction_161 (happy_x_14 `HappyStk` + happy_x_13 `HappyStk` + happy_x_12 `HappyStk` + happy_x_11 `HappyStk` + happy_x_10 `HappyStk` + happy_x_9 `HappyStk` + happy_x_8 `HappyStk` + happy_x_7 `HappyStk` + happy_x_6 `HappyStk` + happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOut4 happy_x_2 of { happy_var_2 -> + happyIn56 + (Dummy happy_var_2 + ) `HappyStk` happyRest} + +happyReduce_162 = happyReduce 15# 53# happyReduction_162 +happyReduction_162 (happy_x_15 `HappyStk` + happy_x_14 `HappyStk` + happy_x_13 `HappyStk` + happy_x_12 `HappyStk` + happy_x_11 `HappyStk` + happy_x_10 `HappyStk` + happy_x_9 `HappyStk` + happy_x_8 `HappyStk` + happy_x_7 `HappyStk` + happy_x_6 `HappyStk` + happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOut4 happy_x_2 of { happy_var_2 -> + happyIn57 + (Dummy happy_var_2 + ) `HappyStk` happyRest} + +happyReduce_163 = happyReduce 16# 54# happyReduction_163 +happyReduction_163 (happy_x_16 `HappyStk` + happy_x_15 `HappyStk` + happy_x_14 `HappyStk` + happy_x_13 `HappyStk` + happy_x_12 `HappyStk` + happy_x_11 `HappyStk` + happy_x_10 `HappyStk` + happy_x_9 `HappyStk` + happy_x_8 `HappyStk` + happy_x_7 `HappyStk` + happy_x_6 `HappyStk` + happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOut4 happy_x_2 of { happy_var_2 -> + happyIn58 + (Dummy happy_var_2 + ) `HappyStk` happyRest} + +happyReduce_164 = happyReduce 17# 55# happyReduction_164 +happyReduction_164 (happy_x_17 `HappyStk` + happy_x_16 `HappyStk` + happy_x_15 `HappyStk` + happy_x_14 `HappyStk` + happy_x_13 `HappyStk` + happy_x_12 `HappyStk` + happy_x_11 `HappyStk` + happy_x_10 `HappyStk` + happy_x_9 `HappyStk` + happy_x_8 `HappyStk` + happy_x_7 `HappyStk` + happy_x_6 `HappyStk` + happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOut4 happy_x_2 of { happy_var_2 -> + happyIn59 + (Dummy happy_var_2 + ) `HappyStk` happyRest} + +happyReduce_165 = happyReduce 18# 56# happyReduction_165 +happyReduction_165 (happy_x_18 `HappyStk` + happy_x_17 `HappyStk` + happy_x_16 `HappyStk` + happy_x_15 `HappyStk` + happy_x_14 `HappyStk` + happy_x_13 `HappyStk` + happy_x_12 `HappyStk` + happy_x_11 `HappyStk` + happy_x_10 `HappyStk` + happy_x_9 `HappyStk` + happy_x_8 `HappyStk` + happy_x_7 `HappyStk` + happy_x_6 `HappyStk` + happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOut4 happy_x_2 of { happy_var_2 -> + happyIn60 + (Dummy happy_var_2 + ) `HappyStk` happyRest} + +happyReduce_166 = happyReduce 19# 57# happyReduction_166 +happyReduction_166 (happy_x_19 `HappyStk` + happy_x_18 `HappyStk` + happy_x_17 `HappyStk` + happy_x_16 `HappyStk` + happy_x_15 `HappyStk` + happy_x_14 `HappyStk` + happy_x_13 `HappyStk` + happy_x_12 `HappyStk` + happy_x_11 `HappyStk` + happy_x_10 `HappyStk` + happy_x_9 `HappyStk` + happy_x_8 `HappyStk` + happy_x_7 `HappyStk` + happy_x_6 `HappyStk` + happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOut4 happy_x_2 of { happy_var_2 -> + happyIn61 + (Dummy happy_var_2 + ) `HappyStk` happyRest} + +happyReduce_167 = happyReduce 20# 58# happyReduction_167 +happyReduction_167 (happy_x_20 `HappyStk` + happy_x_19 `HappyStk` + happy_x_18 `HappyStk` + happy_x_17 `HappyStk` + happy_x_16 `HappyStk` + happy_x_15 `HappyStk` + happy_x_14 `HappyStk` + happy_x_13 `HappyStk` + happy_x_12 `HappyStk` + happy_x_11 `HappyStk` + happy_x_10 `HappyStk` + happy_x_9 `HappyStk` + happy_x_8 `HappyStk` + happy_x_7 `HappyStk` + happy_x_6 `HappyStk` + happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOut4 happy_x_2 of { happy_var_2 -> + happyIn62 + (Dummy happy_var_2 + ) `HappyStk` happyRest} + +happyReduce_168 = happyReduce 21# 59# happyReduction_168 +happyReduction_168 (happy_x_21 `HappyStk` + happy_x_20 `HappyStk` + happy_x_19 `HappyStk` + happy_x_18 `HappyStk` + happy_x_17 `HappyStk` + happy_x_16 `HappyStk` + happy_x_15 `HappyStk` + happy_x_14 `HappyStk` + happy_x_13 `HappyStk` + happy_x_12 `HappyStk` + happy_x_11 `HappyStk` + happy_x_10 `HappyStk` + happy_x_9 `HappyStk` + happy_x_8 `HappyStk` + happy_x_7 `HappyStk` + happy_x_6 `HappyStk` + happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOut4 happy_x_2 of { happy_var_2 -> + happyIn63 + (Dummy happy_var_2 + ) `HappyStk` happyRest} + +happyReduce_169 = happyReduce 22# 60# happyReduction_169 +happyReduction_169 (happy_x_22 `HappyStk` + happy_x_21 `HappyStk` + happy_x_20 `HappyStk` + happy_x_19 `HappyStk` + happy_x_18 `HappyStk` + happy_x_17 `HappyStk` + happy_x_16 `HappyStk` + happy_x_15 `HappyStk` + happy_x_14 `HappyStk` + happy_x_13 `HappyStk` + happy_x_12 `HappyStk` + happy_x_11 `HappyStk` + happy_x_10 `HappyStk` + happy_x_9 `HappyStk` + happy_x_8 `HappyStk` + happy_x_7 `HappyStk` + happy_x_6 `HappyStk` + happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOut4 happy_x_2 of { happy_var_2 -> + happyIn64 + (Dummy happy_var_2 + ) `HappyStk` happyRest} + +happyReduce_170 = happyReduce 6# 61# happyReduction_170 +happyReduction_170 (happy_x_6 `HappyStk` + happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOut4 happy_x_4 of { happy_var_4 -> + happyIn65 + (Dummy happy_var_4 + ) `HappyStk` happyRest} + +happyReduce_171 = happyReduce 7# 62# happyReduction_171 +happyReduction_171 (happy_x_7 `HappyStk` + happy_x_6 `HappyStk` + happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOut4 happy_x_4 of { happy_var_4 -> + happyIn66 + (Dummy happy_var_4 + ) `HappyStk` happyRest} + +happyReduce_172 = happyReduce 8# 63# happyReduction_172 +happyReduction_172 (happy_x_8 `HappyStk` + happy_x_7 `HappyStk` + happy_x_6 `HappyStk` + happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOut4 happy_x_4 of { happy_var_4 -> + happyIn67 + (Dummy happy_var_4 + ) `HappyStk` happyRest} + +happyReduce_173 = happyReduce 9# 64# happyReduction_173 +happyReduction_173 (happy_x_9 `HappyStk` + happy_x_8 `HappyStk` + happy_x_7 `HappyStk` + happy_x_6 `HappyStk` + happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOut4 happy_x_4 of { happy_var_4 -> + happyIn68 + (Dummy happy_var_4 + ) `HappyStk` happyRest} + +happyReduce_174 = happyReduce 10# 65# happyReduction_174 +happyReduction_174 (happy_x_10 `HappyStk` + happy_x_9 `HappyStk` + happy_x_8 `HappyStk` + happy_x_7 `HappyStk` + happy_x_6 `HappyStk` + happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOut4 happy_x_4 of { happy_var_4 -> + happyIn69 + (Dummy happy_var_4 + ) `HappyStk` happyRest} + +happyReduce_175 = happyReduce 11# 66# happyReduction_175 +happyReduction_175 (happy_x_11 `HappyStk` + happy_x_10 `HappyStk` + happy_x_9 `HappyStk` + happy_x_8 `HappyStk` + happy_x_7 `HappyStk` + happy_x_6 `HappyStk` + happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOut4 happy_x_4 of { happy_var_4 -> + happyIn70 + (Dummy happy_var_4 + ) `HappyStk` happyRest} + +happyReduce_176 = happyReduce 12# 67# happyReduction_176 +happyReduction_176 (happy_x_12 `HappyStk` + happy_x_11 `HappyStk` + happy_x_10 `HappyStk` + happy_x_9 `HappyStk` + happy_x_8 `HappyStk` + happy_x_7 `HappyStk` + happy_x_6 `HappyStk` + happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOut4 happy_x_4 of { happy_var_4 -> + happyIn71 + (Dummy happy_var_4 + ) `HappyStk` happyRest} + +happyReduce_177 = happyReduce 13# 68# happyReduction_177 +happyReduction_177 (happy_x_13 `HappyStk` + happy_x_12 `HappyStk` + happy_x_11 `HappyStk` + happy_x_10 `HappyStk` + happy_x_9 `HappyStk` + happy_x_8 `HappyStk` + happy_x_7 `HappyStk` + happy_x_6 `HappyStk` + happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOut4 happy_x_4 of { happy_var_4 -> + happyIn72 + (Dummy happy_var_4 + ) `HappyStk` happyRest} + +happyReduce_178 = happyReduce 14# 69# happyReduction_178 +happyReduction_178 (happy_x_14 `HappyStk` + happy_x_13 `HappyStk` + happy_x_12 `HappyStk` + happy_x_11 `HappyStk` + happy_x_10 `HappyStk` + happy_x_9 `HappyStk` + happy_x_8 `HappyStk` + happy_x_7 `HappyStk` + happy_x_6 `HappyStk` + happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOut4 happy_x_4 of { happy_var_4 -> + happyIn73 + (Dummy happy_var_4 + ) `HappyStk` happyRest} + +happyReduce_179 = happyReduce 15# 70# happyReduction_179 +happyReduction_179 (happy_x_15 `HappyStk` + happy_x_14 `HappyStk` + happy_x_13 `HappyStk` + happy_x_12 `HappyStk` + happy_x_11 `HappyStk` + happy_x_10 `HappyStk` + happy_x_9 `HappyStk` + happy_x_8 `HappyStk` + happy_x_7 `HappyStk` + happy_x_6 `HappyStk` + happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOut4 happy_x_4 of { happy_var_4 -> + happyIn74 + (Dummy happy_var_4 + ) `HappyStk` happyRest} + +happyReduce_180 = happyReduce 6# 71# happyReduction_180 +happyReduction_180 (happy_x_6 `HappyStk` + happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOut4 happy_x_4 of { happy_var_4 -> + happyIn75 + (Dummy happy_var_4 + ) `HappyStk` happyRest} + +happyReduce_181 = happyReduce 7# 72# happyReduction_181 +happyReduction_181 (happy_x_7 `HappyStk` + happy_x_6 `HappyStk` + happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOut4 happy_x_4 of { happy_var_4 -> + happyIn76 + (Dummy happy_var_4 + ) `HappyStk` happyRest} + +happyReduce_182 = happyReduce 8# 73# happyReduction_182 +happyReduction_182 (happy_x_8 `HappyStk` + happy_x_7 `HappyStk` + happy_x_6 `HappyStk` + happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOut4 happy_x_4 of { happy_var_4 -> + happyIn77 + (Dummy happy_var_4 + ) `HappyStk` happyRest} + +happyReduce_183 = happyReduce 9# 74# happyReduction_183 +happyReduction_183 (happy_x_9 `HappyStk` + happy_x_8 `HappyStk` + happy_x_7 `HappyStk` + happy_x_6 `HappyStk` + happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOut4 happy_x_4 of { happy_var_4 -> + happyIn78 + (Dummy happy_var_4 + ) `HappyStk` happyRest} + +happyReduce_184 = happyReduce 10# 75# happyReduction_184 +happyReduction_184 (happy_x_10 `HappyStk` + happy_x_9 `HappyStk` + happy_x_8 `HappyStk` + happy_x_7 `HappyStk` + happy_x_6 `HappyStk` + happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOut4 happy_x_4 of { happy_var_4 -> + happyIn79 + (Dummy happy_var_4 + ) `HappyStk` happyRest} + +happyReduce_185 = happyReduce 11# 76# happyReduction_185 +happyReduction_185 (happy_x_11 `HappyStk` + happy_x_10 `HappyStk` + happy_x_9 `HappyStk` + happy_x_8 `HappyStk` + happy_x_7 `HappyStk` + happy_x_6 `HappyStk` + happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOut4 happy_x_4 of { happy_var_4 -> + happyIn80 + (Dummy happy_var_4 + ) `HappyStk` happyRest} + +happyReduce_186 = happyReduce 12# 77# happyReduction_186 +happyReduction_186 (happy_x_12 `HappyStk` + happy_x_11 `HappyStk` + happy_x_10 `HappyStk` + happy_x_9 `HappyStk` + happy_x_8 `HappyStk` + happy_x_7 `HappyStk` + happy_x_6 `HappyStk` + happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOut4 happy_x_4 of { happy_var_4 -> + happyIn81 + (Dummy happy_var_4 + ) `HappyStk` happyRest} + +happyReduce_187 = happyReduce 13# 78# happyReduction_187 +happyReduction_187 (happy_x_13 `HappyStk` + happy_x_12 `HappyStk` + happy_x_11 `HappyStk` + happy_x_10 `HappyStk` + happy_x_9 `HappyStk` + happy_x_8 `HappyStk` + happy_x_7 `HappyStk` + happy_x_6 `HappyStk` + happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOut4 happy_x_4 of { happy_var_4 -> + happyIn82 + (Dummy happy_var_4 + ) `HappyStk` happyRest} + +happyReduce_188 = happyReduce 14# 79# happyReduction_188 +happyReduction_188 (happy_x_14 `HappyStk` + happy_x_13 `HappyStk` + happy_x_12 `HappyStk` + happy_x_11 `HappyStk` + happy_x_10 `HappyStk` + happy_x_9 `HappyStk` + happy_x_8 `HappyStk` + happy_x_7 `HappyStk` + happy_x_6 `HappyStk` + happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOut4 happy_x_4 of { happy_var_4 -> + happyIn83 + (Dummy happy_var_4 + ) `HappyStk` happyRest} + +happyReduce_189 = happyReduce 15# 80# happyReduction_189 +happyReduction_189 (happy_x_15 `HappyStk` + happy_x_14 `HappyStk` + happy_x_13 `HappyStk` + happy_x_12 `HappyStk` + happy_x_11 `HappyStk` + happy_x_10 `HappyStk` + happy_x_9 `HappyStk` + happy_x_8 `HappyStk` + happy_x_7 `HappyStk` + happy_x_6 `HappyStk` + happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOut4 happy_x_4 of { happy_var_4 -> + happyIn84 + (Dummy happy_var_4 + ) `HappyStk` happyRest} + +happyReduce_190 = happyReduce 6# 81# happyReduction_190 +happyReduction_190 (happy_x_6 `HappyStk` + happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOut4 happy_x_4 of { happy_var_4 -> + happyIn85 + (Dummy happy_var_4 + ) `HappyStk` happyRest} + +happyReduce_191 = happyReduce 7# 82# happyReduction_191 +happyReduction_191 (happy_x_7 `HappyStk` + happy_x_6 `HappyStk` + happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOut4 happy_x_4 of { happy_var_4 -> + happyIn86 + (Dummy happy_var_4 + ) `HappyStk` happyRest} + +happyReduce_192 = happyReduce 8# 83# happyReduction_192 +happyReduction_192 (happy_x_8 `HappyStk` + happy_x_7 `HappyStk` + happy_x_6 `HappyStk` + happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOut4 happy_x_4 of { happy_var_4 -> + happyIn87 + (Dummy happy_var_4 + ) `HappyStk` happyRest} + +happyReduce_193 = happyReduce 9# 84# happyReduction_193 +happyReduction_193 (happy_x_9 `HappyStk` + happy_x_8 `HappyStk` + happy_x_7 `HappyStk` + happy_x_6 `HappyStk` + happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOut4 happy_x_4 of { happy_var_4 -> + happyIn88 + (Dummy happy_var_4 + ) `HappyStk` happyRest} + +happyReduce_194 = happyReduce 10# 85# happyReduction_194 +happyReduction_194 (happy_x_10 `HappyStk` + happy_x_9 `HappyStk` + happy_x_8 `HappyStk` + happy_x_7 `HappyStk` + happy_x_6 `HappyStk` + happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOut4 happy_x_4 of { happy_var_4 -> + happyIn89 + (Dummy happy_var_4 + ) `HappyStk` happyRest} + +happyReduce_195 = happyReduce 11# 86# happyReduction_195 +happyReduction_195 (happy_x_11 `HappyStk` + happy_x_10 `HappyStk` + happy_x_9 `HappyStk` + happy_x_8 `HappyStk` + happy_x_7 `HappyStk` + happy_x_6 `HappyStk` + happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOut4 happy_x_4 of { happy_var_4 -> + happyIn90 + (Dummy happy_var_4 + ) `HappyStk` happyRest} + +happyReduce_196 = happyReduce 12# 87# happyReduction_196 +happyReduction_196 (happy_x_12 `HappyStk` + happy_x_11 `HappyStk` + happy_x_10 `HappyStk` + happy_x_9 `HappyStk` + happy_x_8 `HappyStk` + happy_x_7 `HappyStk` + happy_x_6 `HappyStk` + happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOut4 happy_x_4 of { happy_var_4 -> + happyIn91 + (Dummy happy_var_4 + ) `HappyStk` happyRest} + +happyReduce_197 = happyReduce 13# 88# happyReduction_197 +happyReduction_197 (happy_x_13 `HappyStk` + happy_x_12 `HappyStk` + happy_x_11 `HappyStk` + happy_x_10 `HappyStk` + happy_x_9 `HappyStk` + happy_x_8 `HappyStk` + happy_x_7 `HappyStk` + happy_x_6 `HappyStk` + happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOut4 happy_x_4 of { happy_var_4 -> + happyIn92 + (Dummy happy_var_4 + ) `HappyStk` happyRest} + +happyReduce_198 = happyReduce 14# 89# happyReduction_198 +happyReduction_198 (happy_x_14 `HappyStk` + happy_x_13 `HappyStk` + happy_x_12 `HappyStk` + happy_x_11 `HappyStk` + happy_x_10 `HappyStk` + happy_x_9 `HappyStk` + happy_x_8 `HappyStk` + happy_x_7 `HappyStk` + happy_x_6 `HappyStk` + happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOut4 happy_x_4 of { happy_var_4 -> + happyIn93 + (Dummy happy_var_4 + ) `HappyStk` happyRest} + +happyReduce_199 = happyReduce 15# 90# happyReduction_199 +happyReduction_199 (happy_x_15 `HappyStk` + happy_x_14 `HappyStk` + happy_x_13 `HappyStk` + happy_x_12 `HappyStk` + happy_x_11 `HappyStk` + happy_x_10 `HappyStk` + happy_x_9 `HappyStk` + happy_x_8 `HappyStk` + happy_x_7 `HappyStk` + happy_x_6 `HappyStk` + happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOut4 happy_x_4 of { happy_var_4 -> + happyIn94 + (Dummy happy_var_4 + ) `HappyStk` happyRest} + +happyReduce_200 = happyReduce 6# 91# happyReduction_200 +happyReduction_200 (happy_x_6 `HappyStk` + happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOut4 happy_x_4 of { happy_var_4 -> + happyIn95 + (Dummy happy_var_4 + ) `HappyStk` happyRest} + +happyReduce_201 = happyReduce 7# 92# happyReduction_201 +happyReduction_201 (happy_x_7 `HappyStk` + happy_x_6 `HappyStk` + happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOut4 happy_x_4 of { happy_var_4 -> + happyIn96 + (Dummy happy_var_4 + ) `HappyStk` happyRest} + +happyReduce_202 = happyReduce 8# 93# happyReduction_202 +happyReduction_202 (happy_x_8 `HappyStk` + happy_x_7 `HappyStk` + happy_x_6 `HappyStk` + happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOut4 happy_x_4 of { happy_var_4 -> + happyIn97 + (Dummy happy_var_4 + ) `HappyStk` happyRest} + +happyReduce_203 = happyReduce 9# 94# happyReduction_203 +happyReduction_203 (happy_x_9 `HappyStk` + happy_x_8 `HappyStk` + happy_x_7 `HappyStk` + happy_x_6 `HappyStk` + happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOut4 happy_x_4 of { happy_var_4 -> + happyIn98 + (Dummy happy_var_4 + ) `HappyStk` happyRest} + +happyReduce_204 = happyReduce 10# 95# happyReduction_204 +happyReduction_204 (happy_x_10 `HappyStk` + happy_x_9 `HappyStk` + happy_x_8 `HappyStk` + happy_x_7 `HappyStk` + happy_x_6 `HappyStk` + happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOut4 happy_x_4 of { happy_var_4 -> + happyIn99 + (Dummy happy_var_4 + ) `HappyStk` happyRest} + +happyReduce_205 = happyReduce 11# 96# happyReduction_205 +happyReduction_205 (happy_x_11 `HappyStk` + happy_x_10 `HappyStk` + happy_x_9 `HappyStk` + happy_x_8 `HappyStk` + happy_x_7 `HappyStk` + happy_x_6 `HappyStk` + happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOut4 happy_x_4 of { happy_var_4 -> + happyIn100 + (Dummy happy_var_4 + ) `HappyStk` happyRest} + +happyReduce_206 = happyReduce 12# 97# happyReduction_206 +happyReduction_206 (happy_x_12 `HappyStk` + happy_x_11 `HappyStk` + happy_x_10 `HappyStk` + happy_x_9 `HappyStk` + happy_x_8 `HappyStk` + happy_x_7 `HappyStk` + happy_x_6 `HappyStk` + happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOut4 happy_x_4 of { happy_var_4 -> + happyIn101 + (Dummy happy_var_4 + ) `HappyStk` happyRest} + +happyReduce_207 = happyReduce 13# 98# happyReduction_207 +happyReduction_207 (happy_x_13 `HappyStk` + happy_x_12 `HappyStk` + happy_x_11 `HappyStk` + happy_x_10 `HappyStk` + happy_x_9 `HappyStk` + happy_x_8 `HappyStk` + happy_x_7 `HappyStk` + happy_x_6 `HappyStk` + happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOut4 happy_x_4 of { happy_var_4 -> + happyIn102 + (Dummy happy_var_4 + ) `HappyStk` happyRest} + +happyReduce_208 = happyReduce 14# 99# happyReduction_208 +happyReduction_208 (happy_x_14 `HappyStk` + happy_x_13 `HappyStk` + happy_x_12 `HappyStk` + happy_x_11 `HappyStk` + happy_x_10 `HappyStk` + happy_x_9 `HappyStk` + happy_x_8 `HappyStk` + happy_x_7 `HappyStk` + happy_x_6 `HappyStk` + happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOut4 happy_x_4 of { happy_var_4 -> + happyIn103 + (Dummy happy_var_4 + ) `HappyStk` happyRest} + +happyReduce_209 = happyReduce 15# 100# happyReduction_209 +happyReduction_209 (happy_x_15 `HappyStk` + happy_x_14 `HappyStk` + happy_x_13 `HappyStk` + happy_x_12 `HappyStk` + happy_x_11 `HappyStk` + happy_x_10 `HappyStk` + happy_x_9 `HappyStk` + happy_x_8 `HappyStk` + happy_x_7 `HappyStk` + happy_x_6 `HappyStk` + happy_x_5 `HappyStk` + happy_x_4 `HappyStk` + happy_x_3 `HappyStk` + happy_x_2 `HappyStk` + happy_x_1 `HappyStk` + happyRest) + = case happyOut4 happy_x_4 of { happy_var_4 -> + happyIn104 + (Dummy happy_var_4 + ) `HappyStk` happyRest} + +happyNewToken action sts stk [] = + happyDoAction 16# notHappyAtAll action sts stk [] + +happyNewToken action sts stk (tk:tks) = + let cont i = happyDoAction i tk action sts stk tks in + case tk of { + TokenLet -> cont 1#; + TokenIn -> cont 2#; + TokenInt happy_dollar_dollar -> cont 3#; + TokenSym happy_dollar_dollar -> cont 4#; + TokenEq -> cont 5#; + TokenPlus -> cont 6#; + TokenMinus -> cont 7#; + TokenTimes -> cont 8#; + TokenDiv -> cont 9#; + TokenLParen -> cont 10#; + TokenRParen -> cont 11#; + TokenLCurl -> cont 12#; + TokenRCurl -> cont 13#; + TokenLRect -> cont 14#; + TokenRRect -> cont 15#; + _ -> happyError' ((tk:tks), []) + } + +happyError_ explist 16# tk tks = happyError' (tks, explist) +happyError_ explist _ tk tks = happyError' ((tk:tks), explist) + +newtype HappyIdentity a = HappyIdentity a +happyIdentity = HappyIdentity +happyRunIdentity (HappyIdentity a) = a + +instance Functor HappyIdentity where + fmap f (HappyIdentity a) = HappyIdentity (f a) + +instance Applicative HappyIdentity where + pure = HappyIdentity + (<*>) = ap +instance Monad HappyIdentity where + return = pure + (HappyIdentity p) >>= q = q p + +happyThen :: () => HappyIdentity a -> (a -> HappyIdentity b) -> HappyIdentity b +happyThen = (>>=) +happyReturn :: () => a -> HappyIdentity a +happyReturn = (return) +happyThen1 m k tks = (>>=) m (\a -> k a tks) +happyReturn1 :: () => a -> b -> HappyIdentity a +happyReturn1 = \a tks -> (return) a +happyError' :: () => ([(Token)], [String]) -> HappyIdentity a +happyError' = HappyIdentity . (\(tokens, _) -> parseError tokens) +parseCalc tks = happyRunIdentity happySomeParser where + happySomeParser = happyThen (happyParse 0# tks) (\x -> happyReturn (happyOut4 x)) + +happySeq = happyDontSeq + + +parseError :: [Token] -> a +parseError _ = error "Parse error" + +data Exp = Let String Exp Exp + | Plus Exp Exp + | Minus Exp Exp + | Times Exp Exp + | Div Exp Exp + | Negate Exp + | Brack Exp + | Int Int + | Var String + | Dummy Exp + deriving Show + +data Happy_IntList = HappyCons Happy_GHC_Exts.Int# Happy_IntList + +infixr 9 `HappyStk` +data HappyStk a = HappyStk a (HappyStk a) + +----------------------------------------------------------------------------- +-- starting the parse + +happyParse start_state = happyNewToken start_state notHappyAtAll notHappyAtAll + +----------------------------------------------------------------------------- +-- Accepting the parse + +-- If the current token is 0#, it means we've just accepted a partial +-- parse (a %partial parser). We must ignore the saved token on the top of +-- the stack in this case. +happyAccept 0# tk st sts (_ `HappyStk` ans `HappyStk` _) = + happyReturn1 ans +happyAccept j tk st sts (HappyStk ans _) = + (happyTcHack j (happyTcHack st)) (happyReturn1 ans) + +----------------------------------------------------------------------------- +-- Arrays only: do the next action + + +happyDoAction i tk st + = {- nothing -} + case action of + 0# -> {- nothing -} + happyFail (happyExpListPerState ((Happy_GHC_Exts.I# (st)) :: Int)) i tk st + -1# -> {- nothing -} + happyAccept i tk st + n | ((Happy_GHC_Exts.tagToEnum# (n Happy_GHC_Exts.<# (0# :: Happy_GHC_Exts.Int#))) :: Bool) -> {- nothing -} + + (happyReduceArr Happy_Data_Array.! rule) i tk st + where rule = (Happy_GHC_Exts.I# ((Happy_GHC_Exts.negateInt# ((n Happy_GHC_Exts.+# (1# :: Happy_GHC_Exts.Int#)))))) + n -> {- nothing -} + + + happyShift new_state i tk st + where new_state = (n Happy_GHC_Exts.-# (1# :: Happy_GHC_Exts.Int#)) + where off = happyAdjustOffset (indexShortOffAddr happyActOffsets st) + off_i = (off Happy_GHC_Exts.+# i) + check = if ((Happy_GHC_Exts.tagToEnum# (off_i Happy_GHC_Exts.>=# (0# :: Happy_GHC_Exts.Int#))) :: Bool) + then ((Happy_GHC_Exts.tagToEnum# (indexShortOffAddr happyCheck off_i Happy_GHC_Exts.==# i)) :: Bool) + else False + action + | check = indexShortOffAddr happyTable off_i + | otherwise = indexShortOffAddr happyDefActions st + +indexShortOffAddr (HappyA# arr) off = + Happy_GHC_Exts.narrow16Int# i + where + i = Happy_GHC_Exts.word2Int# (Happy_GHC_Exts.or# (Happy_GHC_Exts.uncheckedShiftL# high 8#) low) + high = Happy_GHC_Exts.int2Word# (Happy_GHC_Exts.ord# (Happy_GHC_Exts.indexCharOffAddr# arr (off' Happy_GHC_Exts.+# 1#))) + low = Happy_GHC_Exts.int2Word# (Happy_GHC_Exts.ord# (Happy_GHC_Exts.indexCharOffAddr# arr off')) + off' = off Happy_GHC_Exts.*# 2# + +{-# INLINE happyLt #-} +happyLt x y = ((Happy_GHC_Exts.tagToEnum# (x Happy_GHC_Exts.<# y)) :: Bool) + +readArrayBit arr bit = + Bits.testBit (Happy_GHC_Exts.I# (indexShortOffAddr arr ((unbox_int bit) `Happy_GHC_Exts.iShiftRA#` 4#))) (bit `mod` 16) + where unbox_int (Happy_GHC_Exts.I# x) = x + +data HappyAddr = HappyA# Happy_GHC_Exts.Addr# + +----------------------------------------------------------------------------- +-- Shifting a token + +happyShift new_state 0# tk st sts stk@(x `HappyStk` _) = + let i = (case Happy_GHC_Exts.unsafeCoerce# x of { (Happy_GHC_Exts.I# (i)) -> i }) in +-- trace "shifting the error token" $ + happyDoAction i tk new_state (HappyCons (st) (sts)) (stk) + +happyShift new_state i tk st sts stk = + happyNewToken new_state (HappyCons (st) (sts)) ((happyInTok (tk))`HappyStk`stk) + +-- happyReduce is specialised for the common cases. + +happySpecReduce_0 i fn 0# tk st sts stk + = happyFail [] 0# tk st sts stk +happySpecReduce_0 nt fn j tk st@((action)) sts stk + = happyGoto nt j tk st (HappyCons (st) (sts)) (fn `HappyStk` stk) + +happySpecReduce_1 i fn 0# tk st sts stk + = happyFail [] 0# tk st sts stk +happySpecReduce_1 nt fn j tk _ sts@((HappyCons (st@(action)) (_))) (v1`HappyStk`stk') + = let r = fn v1 in + happySeq r (happyGoto nt j tk st sts (r `HappyStk` stk')) + +happySpecReduce_2 i fn 0# tk st sts stk + = happyFail [] 0# tk st sts stk +happySpecReduce_2 nt fn j tk _ (HappyCons (_) (sts@((HappyCons (st@(action)) (_))))) (v1`HappyStk`v2`HappyStk`stk') + = let r = fn v1 v2 in + happySeq r (happyGoto nt j tk st sts (r `HappyStk` stk')) + +happySpecReduce_3 i fn 0# tk st sts stk + = happyFail [] 0# tk st sts stk +happySpecReduce_3 nt fn j tk _ (HappyCons (_) ((HappyCons (_) (sts@((HappyCons (st@(action)) (_))))))) (v1`HappyStk`v2`HappyStk`v3`HappyStk`stk') + = let r = fn v1 v2 v3 in + happySeq r (happyGoto nt j tk st sts (r `HappyStk` stk')) + +happyReduce k i fn 0# tk st sts stk + = happyFail [] 0# tk st sts stk +happyReduce k nt fn j tk st sts stk + = case happyDrop (k Happy_GHC_Exts.-# (1# :: Happy_GHC_Exts.Int#)) sts of + sts1@((HappyCons (st1@(action)) (_))) -> + let r = fn stk in -- it doesn't hurt to always seq here... + happyDoSeq r (happyGoto nt j tk st1 sts1 r) + +happyMonadReduce k nt fn 0# tk st sts stk + = happyFail [] 0# tk st sts stk +happyMonadReduce k nt fn j tk st sts stk = + case happyDrop k (HappyCons (st) (sts)) of + sts1@((HappyCons (st1@(action)) (_))) -> + let drop_stk = happyDropStk k stk in + happyThen1 (fn stk tk) (\r -> happyGoto nt j tk st1 sts1 (r `HappyStk` drop_stk)) + +happyMonad2Reduce k nt fn 0# tk st sts stk + = happyFail [] 0# tk st sts stk +happyMonad2Reduce k nt fn j tk st sts stk = + case happyDrop k (HappyCons (st) (sts)) of + sts1@((HappyCons (st1@(action)) (_))) -> + let drop_stk = happyDropStk k stk + + off = happyAdjustOffset (indexShortOffAddr happyGotoOffsets st1) + off_i = (off Happy_GHC_Exts.+# nt) + new_state = indexShortOffAddr happyTable off_i + + + + + in + happyThen1 (fn stk tk) (\r -> happyNewToken new_state sts1 (r `HappyStk` drop_stk)) + +happyDrop 0# l = l +happyDrop n (HappyCons (_) (t)) = happyDrop (n Happy_GHC_Exts.-# (1# :: Happy_GHC_Exts.Int#)) t + +happyDropStk 0# l = l +happyDropStk n (x `HappyStk` xs) = happyDropStk (n Happy_GHC_Exts.-# (1#::Happy_GHC_Exts.Int#)) xs + +----------------------------------------------------------------------------- +-- Moving to a new state after a reduction + + +happyGoto nt j tk st = + {- nothing -} + happyDoAction j tk new_state + where off = happyAdjustOffset (indexShortOffAddr happyGotoOffsets st) + off_i = (off Happy_GHC_Exts.+# nt) + new_state = indexShortOffAddr happyTable off_i + + + + +----------------------------------------------------------------------------- +-- Error recovery (0# is the error token) + +-- parse error if we are in recovery and we fail again +happyFail explist 0# tk old_st _ stk@(x `HappyStk` _) = + let i = (case Happy_GHC_Exts.unsafeCoerce# x of { (Happy_GHC_Exts.I# (i)) -> i }) in +-- trace "failing" $ + happyError_ explist i tk + +{- We don't need state discarding for our restricted implementation of + "error". In fact, it can cause some bogus parses, so I've disabled it + for now --SDM + +-- discard a state +happyFail 0# tk old_st (HappyCons ((action)) (sts)) + (saved_tok `HappyStk` _ `HappyStk` stk) = +-- trace ("discarding state, depth " ++ show (length stk)) $ + happyDoAction 0# tk action sts ((saved_tok`HappyStk`stk)) +-} + +-- Enter error recovery: generate an error token, +-- save the old token and carry on. +happyFail explist i tk (action) sts stk = +-- trace "entering error recovery" $ + happyDoAction 0# tk action sts ( (Happy_GHC_Exts.unsafeCoerce# (Happy_GHC_Exts.I# (i))) `HappyStk` stk) + +-- Internal happy errors: + +notHappyAtAll :: a +notHappyAtAll = error "Internal Happy error\n" + +----------------------------------------------------------------------------- +-- Hack to get the typechecker to accept our action functions + + +happyTcHack :: Happy_GHC_Exts.Int# -> a -> a +happyTcHack x y = y +{-# INLINE happyTcHack #-} + + +----------------------------------------------------------------------------- +-- Seq-ing. If the --strict flag is given, then Happy emits +-- happySeq = happyDoSeq +-- otherwise it emits +-- happySeq = happyDontSeq + +happyDoSeq, happyDontSeq :: a -> b -> b +happyDoSeq a b = a `seq` b +happyDontSeq a b = b + +----------------------------------------------------------------------------- +-- Don't inline any functions from the template. GHC has a nasty habit +-- of deciding to inline happyGoto everywhere, which increases the size of +-- the generated parser quite a bit. + + +{-# NOINLINE happyDoAction #-} +{-# NOINLINE happyTable #-} +{-# NOINLINE happyCheck #-} +{-# NOINLINE happyActOffsets #-} +{-# NOINLINE happyGotoOffsets #-} +{-# NOINLINE happyDefActions #-} + +{-# NOINLINE happyShift #-} +{-# NOINLINE happySpecReduce_0 #-} +{-# NOINLINE happySpecReduce_1 #-} +{-# NOINLINE happySpecReduce_2 #-} +{-# NOINLINE happySpecReduce_3 #-} +{-# NOINLINE happyReduce #-} +{-# NOINLINE happyMonadReduce #-} +{-# NOINLINE happyGoto #-} +{-# NOINLINE happyFail #-} + +-- end of Happy Template. diff --git a/testsuite/tests/perf/compiler/T15164.hs b/testsuite/tests/perf/compiler/T15164.hs new file mode 100644 index 0000000000..0f29623228 --- /dev/null +++ b/testsuite/tests/perf/compiler/T15164.hs @@ -0,0 +1,501 @@ +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MonoLocalBinds #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE UndecidableInstances #-} + +module T15164 () where + +data Version = VHDL1993 +data T +data NT a + +class Rule f a where + get :: Decorator f => f a + +class Monad f => Decorator f where + n :: [Version] -> f a -> f (NT a) -- n stands for both NT as well as Node (in grammar tree) + chr :: Char -> [Version] -> f T + txt :: String -> [Version] -> f T -- token OPTIONALLY followed by spaces + + -- combinators + m :: f a -> f [a] + c :: [f a] -> f a -- c stands for choose + o :: f a -> f (Maybe a) -- o stands for optional + trace :: String -> f a -> f a + + -- helper functions in the grammar + n93 :: Rule f a => f (NT a) + n93 = n [VHDL1993] get + + + parenOpen :: f T + parenOpen = chr '(' [VHDL1993] + + parenClose :: f T + parenClose = chr ')' [VHDL1993] + + comma :: f T + comma = chr ',' [VHDL1993] + + moreComma :: Rule f a => f [(T, NT a)] + moreComma = m $ do + cc <- comma + cont <- n93 + return (cc, cont) + +type P_MaybeActualParameterPart = (Maybe (T, (NT ActualParameterPart), T)) +maybeActualParameterPart :: Decorator f => f (Maybe (T, NT ActualParameterPart, T)) +maybeActualParameterPart = o $ do + po <- parenOpen + app <- (n93 :: Decorator f => f (NT ActualParameterPart)) + pc <- parenClose + return (po, app, pc) +-- helper function used with FormalPart and ActualPart +-- dcon '(' actual_designator ')' +mkNameOrTypeMark :: (Decorator m, Rule m a1, Rule m a) => (NT a -> T -> NT a1 -> T -> b) -> m b +mkNameOrTypeMark dcon = do + name_typemark <- n93 -- either Name OR TypeMark depending on dcon !! + po <- parenOpen + fd <- n93 + pc <- parenClose + return $ dcon name_typemark po fd pc + +-- actual_designator +-- ::= expression +-- | name +-- | 'OPEN' +data ActualDesignator = AD1 (NT Expression) | AD2 (NT Name) | AD3 T +instance Rule f ActualDesignator where + get = trace "ActualDesignator" $ {-# SCC "get_ActualDesignator" #-} c + [ AD3 <$> (txt "open" [VHDL1993]) -- order matters here + , AD2 <$> n93 -- try a simple name first + , AD1 <$> n93 + -- [ AD3 <$> txt "open" [VHDL1993] -- order matters here + -- , AD2 <$> (n93 :: f (NT Name)) -- try a simple name first + -- , AD1 <$> (n93 :: f (NT Expression)) + ] + +-- actual_parameter_part +-- ::= association_list +newtype ActualParameterPart = APP (NT AssociationList) +instance Rule f AssociationList => Rule f ActualParameterPart where + get = APP <$> n93 + +-- actual_part +-- ::= actual_designator +-- | ( name | type_mark ) '(' actual_designator ')' +data ActualPart = AP1 (NT ActualDesignator) | APName (NT Name) T (NT ActualDesignator) T | APTypeMark (NT TypeMark) T (NT ActualDesignator) T +instance (Rule f ActualDesignator, Rule f Name, Rule f TypeMark) => Rule f ActualPart where + get = trace "ActualPart" $ {-# SCC "get_ActualPart" #-} c + [ AP1 <$> n93 + , mkNameOrTypeMark APName + , mkNameOrTypeMark APTypeMark + ] + +-- aggregate +-- ::= '(' element_association ( ',' element_association )* ')' +data Aggregate = MkAggregate T (NT ElementAssociation) [(T, (NT ElementAssociation))] T +instance Rule f ElementAssociation => Rule f Aggregate where + get = do + po <- parenOpen + ea <- n93 + rest <- moreComma + pc <- parenClose + return $ MkAggregate po ea rest pc + +-- allocator +-- ::= 'NEW' ( subtype_indication | qualified_expression ) +data Allocator = A1 T (NT SubtypeIndication) | A2 T (NT QualifiedExpression) +instance (Rule f SubtypeIndication, Rule f QualifiedExpression) => Rule f Allocator where + get = c + [ A1 <$> (txt "new" [VHDL1993]) <*> n93 + , A2 <$> (txt "new" [VHDL1993]) <*> n93 + ] + +-- association_element +-- ::= ( formal_part '=>' )? actual_part +data AssociationElement = AE (Maybe (NT FormalPart, T)) (NT ActualPart) +instance (Rule f FormalPart, Rule f ActualPart) => Rule f AssociationElement where + get = do + fp <- o $ do + f <- n93 + a <- txt "=>" [VHDL1993] + return (f, a) + ap <- n93 + return $ AE fp ap + +-- association_list +-- ::= association_element ( ',' association_element )* +data AssociationList = AL (NT AssociationElement) [(T, NT AssociationElement)] +instance Rule f AssociationElement => Rule f AssociationList where + get = do + ae <- n93 + rest <- moreComma + return $ AL ae rest + +-- attribute_name +-- ::= prefix signature? "'" attribute_designator ( '(' expression ')' )? +data AttributeName = AN (NT Prefix) (Maybe (NT TypeMark)) T (Maybe (T, (NT Expression), T)) +instance (Rule f Prefix, Rule f TypeMark, Rule f Expression) => Rule f AttributeName where + get = do + pp <- n93 + ss <- o n93 + cc <- chr '\'' [VHDL1993] + -- ad <- n93 + ee <- o $ do + po <- parenOpen + e <- n93 + pc <- parenClose + return (po, e, pc) + return $ AN pp ss cc ee + +-- choice ::= simple_expression +-- | discrete_range +-- | simple_name +-- | 'OTHERS' +data Choice = + CSmimpleExpression (NT SimpleExpression) + | CDiscreteRange (NT DiscreteRange) + -- | CSimpleName (NT SimpleName) + | COthers T + +instance (Rule f SimpleExpression, Rule f DiscreteRange) => Rule f Choice where + get = c + [ CSmimpleExpression <$> n93 + , CDiscreteRange <$> n93 + -- , CSimpleName <$> n93 + , COthers <$> txt "others" [VHDL1993] + ] + +-- constraint +-- ::= range_constraint +-- | index_constraint +data Constraint = CRange (NT RangeConstraint) | CIndex (NT DiscreteRange) +instance (Rule f RangeConstraint, Rule f DiscreteRange) => Rule f Constraint where + get = c + [ CRange <$> n93 + , CIndex <$> n93 + ] + +-- discrete_range +-- ::= subtype_indication +-- | range +data DiscreteRange = DRSubtypeIndication (NT SubtypeIndication) | DRRange (NT Range) +instance (Rule f SubtypeIndication, Rule f Range) => Rule f DiscreteRange where + get = c + [ DRSubtypeIndication <$> n93 + , DRRange <$> n93 + ] + +-- element_association +-- ::= ( choices '=>' )? expression +data ElementAssociation = EA (Maybe (NT Choice, T)) (NT Expression) +instance (Rule f Choice, Rule f Expression) => Rule f ElementAssociation where + get = do + c <- o $ do + c <- n93 + a <- txt "=>" [VHDL1993] + return (c, a) + e <- n93 + return $ EA c e + +-- expression +-- ::= relation ( ( 'AND' relation )* | ( 'OR' relation )* | ( 'XOR' relation )* | ( 'NAND' | 'NOR' ) relation | ( 'XNOR' relation )* ) +data Expression = + And (NT SimpleExpression) [(T, (NT SimpleExpression))] + | Or (NT SimpleExpression) [(T, (NT SimpleExpression))] + | Xor (NT SimpleExpression) [(T, (NT SimpleExpression))] + | Nand (NT SimpleExpression) (T, (NT SimpleExpression)) + | Nor (NT SimpleExpression) (T, (NT SimpleExpression)) + | Xnor (NT SimpleExpression) [(T, (NT SimpleExpression))] + +instance Rule f SimpleExpression => Rule f Expression where + get = {-# SCC "get_IndexedName" #-} c + [ And <$> n93 <*> emore "and" + , Or <$> n93 <*> emore "or" + , Xor <$> n93 <*> emore "xor" + , Nand <$> n93 <*> etwo "nand" + , Nor <$> n93 <*> etwo "nor" + , Xnor <$> n93 <*> emore "xnor" + ] + where etwo tok = do + n1 <- txt tok [VHDL1993] + n2 <- n93 + return (n1, n2) + emore tok = do + m $ do + n2 <- txt tok [VHDL1993] + n3 <- n93 + return (n2, n3) + +-- factor ::= ( primary '**' | 'ABS' | 'NOT' )? primary +data Factor = FPower (NT Primary) (Maybe (T, (NT Primary))) | FAbs T (NT Primary) | FNot T (NT Primary) +instance Rule f Primary => Rule f Factor where + get = trace "Factor" $ {-# SCC "get_Factor" #-} c -- c + [ do + p <- n93 + rest <- o $ do + p <- txt "**" [VHDL1993] + p2 <- n93 + return (p, p2) + return $ FPower p rest + , FAbs <$> (txt "abs" [VHDL1993]) <*> n93 + , FNot <$> (txt "not" [VHDL1993]) <*> n93 + ] + +-- formal_designator +-- ::= name +newtype FormalDesignator = MkFormalDesignator (NT Name) +instance Rule f Name => Rule f FormalDesignator where + get = trace "FormalDesignator" $ {-# SCC "get_FormalDesignator" #-} MkFormalDesignator <$> n93 + +-- formal_part +-- ::= formal_designator +-- | ( name | type_mark ) '(' formal_designator ')' +data FormalPart = FP1 (NT FormalDesignator) | FPName (NT Name) T (NT FormalDesignator) T | FPTypeMark (NT TypeMark) T (NT FormalDesignator) T +instance (Rule f FormalDesignator, Rule f Name, Rule f TypeMark) => Rule f FormalPart where + get = trace "FormalPart" $ {-# SCC "get_FormalPart" #-} c + [ FP1 <$> n93 + , mkNameOrTypeMark FPName + , mkNameOrTypeMark FPTypeMark + ] + +-- function_call +-- ::= name ( '(' actual_parameter_part ')' )? +data FunctionCall = FC (NT Name) P_MaybeActualParameterPart +-- redundant: Rule f ActualParameterPart +instance Rule f Name => Rule f FunctionCall where + get = trace "FunctionCall" $ {-# SCC "get_FunctionCall" #-} do + nn <- n93 + app <- maybeActualParameterPart + return $ FC nn app + +-- index_constraint +-- ::= '(' discrete_range ( ',' discrete_range )* ')' +data IndexConstraint = IC T (NT DiscreteRange) [(T, NT DiscreteRange)] T +instance Rule f DiscreteRange => Rule f IndexConstraint where + get = do + po <- parenOpen + dr <- n93 + rest <- moreComma + pc <- parenClose + return $ IC po dr rest pc + +-- indexed_name +-- ::= prefix '(' expression ( ',' expression )* ')' +data IndexedName = IN (NT Prefix) T (NT Expression) [(T, NT Expression)] T +instance (Rule f Prefix, Rule f Expression) => Rule f IndexedName where + get = {-# SCC "get_IndexedName" #-} do + pp <- n93 + po <- parenOpen + ee <- n93 + ee2 <- moreComma + pc <- parenClose + return $ IN pp po ee ee2 pc + +-- literal ::= numeric_literal +-- | enumeration_literal +-- | string_literal +-- | bit_string_literal +-- | 'NULL' +data Literal = + LNumericLiteral (NT Name) + -- | LEnumerationLiteral (NT EnumerationLiteral) + -- | LStringLiteral (NT StringLiteral) + -- | LBitStringLiteral (NT BitStringLiteral) + | LNull T + +instance (Rule f Name) => Rule f Literal where + get = c + [ LNumericLiteral <$> n93 + -- , LEnumerationLiteral <$> n93 + -- , LStringLiteral <$> n93 + -- , LBitStringLiteral <$> n93 + , LNull <$> txt "null" [VHDL1993] + ] + +-- name ::= simple_name +-- | operator_symbol +-- | selected_name +-- | indexed_name +-- | slice_name +-- | attribute_name +data Name = N3 (NT Prefix) | N4 (NT IndexedName) | N6 (NT AttributeName) +instance (Rule f Prefix, Rule f IndexedName, Rule f AttributeName) => Rule f Name where + get = trace "Name" $ {-# SCC "get_Name" #-} c + [ N3 <$> n93 + , N4 <$> n93 + -- , N5 <$> n93 + , N6 <$> n93 + ] + +-- prefix ::= name +-- | function_call +data Prefix = PrefixName (NT Name) | PrefixFunctionCall (NT FunctionCall) +instance (Rule f Name, Rule f FunctionCall) => Rule f Prefix where + get = trace "Prefix" $ {-# SCC "get_Prefix" #-} c + [ PrefixName <$> n93 + , PrefixFunctionCall <$> n93 + ] + +-- primary ::= name +-- | literal +-- | aggregate +-- | function_call +-- | qualified_expression +-- | type_conversion +-- | allocator +-- | '(' expression ')' +data Primary = + PName (NT Name) + -- | PLiteral (NT Literal) + | PAggregate (NT Aggregate) + | PFunctionCall (NT FunctionCall) + | PQualifiedExpression (NT QualifiedExpression) + | PTypeConversion (NT TypeConversion) + | PAllocator (NT Allocator) + | PExpression T (NT Expression) T + +--get_levels: instance (Rule f Name, Rule f Aggregate, Rule f FunctionCall, Rule f QualifiedExpression, Rule f TypeConversion, Rule f Allocator, Rule f Expression) => Rule f Primary where +instance (Rule f Name, Rule f Aggregate, Rule f FunctionCall, Rule f QualifiedExpression + , Rule f TypeConversion, Rule f Allocator, Rule f Expression) => Rule f Primary where + get = trace "Primary" $ {-# SCC "get_Primary" #-} c + [ PName <$> n93 + -- , PLiteral <$> n93 + , PAggregate <$> n93 + , PFunctionCall <$> n93 + , PQualifiedExpression <$> n93 + , PTypeConversion <$> n93 + , PAllocator <$> n93 + , exp + -- [ PName <$> (n93 :: f (NT Name)) + -- , PLiteral <$> (n93 :: f (NT Literal)) + -- , PAggregate <$> (n93 :: f (NT Aggregate)) + -- , PFunctionCall <$> (n93 :: f (NT FunctionCall)) + -- , PQualifiedExpression <$> (n93 :: f (NT QualifiedExpression)) + -- , PTypeConversion <$> (n93 :: f (NT TypeConversion)) + -- , PAllocator <$> (n93 :: f (NT Allocator)) + -- , PExpression <$> parenOpen <*> (n93 :: f (NT Expression)) <*> parenClose + -- , exp + ] + where exp = do + po <- parenOpen + ee <- n93 + pc <- parenClose + return $ PExpression po ee pc + +-- qualified_expression +-- ::= type_mark "'" ( '(' expression ')' | aggregate ) +data QualifiedExpression = QEExpression (NT TypeMark) T T (NT Expression) T | EQAggregate (NT TypeMark) T +instance (Rule f TypeMark, Rule f Expression) => Rule f QualifiedExpression where + get = c [qexp, qagg] + where qexp = do + tm <- n93 + q <- chr '\'' [VHDL1993] + po <- parenOpen + ee <- n93 + pc <- parenClose + return $ QEExpression tm q po ee pc + qagg = do + tm <- n93 + q <- chr '\'' [VHDL1993] + -- a <- n93 + return $ EQAggregate tm q + +-- range ::= attribute_name +-- | simple_expression direction simple_expression +data Range = R1 (NT AttributeName) | R2 (NT SimpleExpression) (NT SimpleExpression) +instance (Rule f AttributeName, Rule f SimpleExpression) => Rule f Range where + get = c + [ R1 <$> n93 + , R2 <$> n93<*> n93 + ] + +-- range_constraint +-- ::= 'range' range +data RangeConstraint = RC T (NT Range) +instance Rule f Range => Rule f RangeConstraint where + get = do + r1 <- txt "range" [VHDL1993] + r2 <- n93 + return $ RC r1 r2 + +-- relation +-- ::= shift_expression ( relational_operator shift_expression )? +data Relation = R (NT SimpleExpression) (Maybe ((NT SimpleExpression))) +instance (Rule f SimpleExpression) => Rule f Relation where + get = do + se <- n93 + rest <- o $ do + -- ro <- n93 + se <- n93 + return se + return $ R se rest + +-- shift_expression +-- ::= simple_expression ( shift_operator simple_expression )? +data ShiftExpression = ShiftE (NT SimpleExpression) (Maybe ((NT SimpleExpression))) +instance (Rule f SimpleExpression) => Rule f ShiftExpression where + get = do + se <- n93 + rest <- o $ do + -- so <- n93 + se <- n93 + return se + return $ ShiftE se rest + +-- simple_expression +-- ::= sign? term ( adding_operator term )* +data SimpleExpression = SimpleE (NT Primary) [(NT Primary)] +-- data SimpleExpression = SimpleE T +instance (Rule f Primary) => Rule f SimpleExpression where + -- get = SimpleE <$> txt "bla" [VHDL1993] + get = do + -- ss <- o n93 + tt <- n93 + rest <- m $ do + -- ao <- n93 + tt2 <- n93 + return tt2 + return $ SimpleE tt rest + +-- slice_name +-- ::= prefix '(' discrete_range ')' +data SliceName = SliceNPrefix (NT DiscreteRange) +instance Rule f DiscreteRange => Rule f SliceName where + get = SliceNPrefix <$> n93 + +-- subtype_indication +-- ::= name? type_mark constraint? +data SubtypeIndication = SI (Maybe (NT Name)) (NT TypeMark) (Maybe (NT Constraint)) +instance (Rule f Name, Rule f TypeMark, Rule f Constraint) => Rule f SubtypeIndication where + get = trace "SubtypeIndication" $ {-# SCC "get_SubtypeIndication" #-} do + nn <- o n93 + tm <- n93 + cc <- o n93 + return $ SI nn tm cc + +-- type_conversion +-- ::= type_mark '(' expression ')' +data TypeConversion = MkTypeConversion (NT TypeMark) T (NT Expression) T +instance (Rule f TypeMark, Rule f Expression) => Rule f TypeConversion where + get = do + tm <- n93 + po <- parenOpen + e <- n93 + pc <- parenClose + return $ MkTypeConversion tm po e pc + +-- type_mark +-- ::= type_name | subtype_name +data TypeMark = TM1 (NT Name) | TM2 (NT Name) +instance Rule f Name => Rule f TypeMark where + get = trace "TypeMark" $ {-# SCC "get_TypeMark" #-} c + [ TM1 <$> n93 + , TM2 <$> n93 + ] diff --git a/testsuite/tests/perf/compiler/T4007.stdout b/testsuite/tests/perf/compiler/T4007.stdout index 9b23359663..14e7bf82e3 100644 --- a/testsuite/tests/perf/compiler/T4007.stdout +++ b/testsuite/tests/perf/compiler/T4007.stdout @@ -1,8 +1,10 @@ Rule fired: Class op foldr (BUILTIN) -Rule fired: Class op >> (BUILTIN) Rule fired: Class op return (BUILTIN) Rule fired: unpack (GHC.Base) Rule fired: fold/build (GHC.Base) +Rule fired: Class op >> (BUILTIN) +Rule fired: Class op >> (BUILTIN) +Rule fired: SPEC/T4007 sequence__c @ IO _ _ (T4007) Rule fired: <# (BUILTIN) Rule fired: tagToEnum# (BUILTIN) Rule fired: unpack-list (GHC.Base) diff --git a/testsuite/tests/perf/compiler/T9872b.stderr b/testsuite/tests/perf/compiler/T9872b.stderr index d2d8ad8441..6224056185 100644 --- a/testsuite/tests/perf/compiler/T9872b.stderr +++ b/testsuite/tests/perf/compiler/T9872b.stderr @@ -2,22 +2,22 @@ T9872b.hs:19:8: No instance for (Show (Proxy - '['['Cube 'G 'B 'W 'R 'B 'G, 'Cube 'W 'G 'B 'W 'R 'R, - 'Cube 'R 'W 'R 'B 'G 'R, 'Cube 'B 'R 'G 'G 'W 'W], - '['Cube 'G 'B 'R 'W 'B 'G, 'Cube 'R 'R 'W 'B 'G 'W, - 'Cube 'R 'G 'B 'R 'W 'R, 'Cube 'W 'W 'G 'G 'R 'B], - '['Cube 'G 'W 'R 'B 'B 'G, 'Cube 'W 'B 'W 'R 'G 'R, - 'Cube 'R 'R 'B 'G 'W 'R, 'Cube 'B 'G 'G 'W 'R 'W], - '['Cube 'G 'R 'W 'B 'B 'G, 'Cube 'R 'W 'B 'G 'R 'W, - 'Cube 'R 'B 'R 'W 'G 'R, 'Cube 'W 'G 'G 'R 'W 'B], - '['Cube 'G 'R 'B 'B 'W 'G, 'Cube 'W 'W 'R 'G 'B 'R, - 'Cube 'R 'B 'G 'W 'R 'R, 'Cube 'B 'G 'W 'R 'G 'W], - '['Cube 'G 'W 'B 'B 'R 'G, 'Cube 'R 'B 'G 'R 'W 'W, - 'Cube 'R 'R 'W 'G 'B 'R, 'Cube 'W 'G 'R 'W 'G 'B], - '['Cube 'G 'B 'B 'W 'R 'G, 'Cube 'W 'R 'G 'B 'W 'R, - 'Cube 'R 'G 'W 'R 'B 'R, 'Cube 'B 'W 'R 'G 'G 'W], - '['Cube 'G 'B 'B 'R 'W 'G, 'Cube 'R 'G 'R 'W 'B 'W, - 'Cube 'R 'W 'G 'B 'R 'R, 'Cube 'W 'R 'W 'G 'G 'B]])) + '[ '[ 'Cube 'G 'B 'W 'R 'B 'G, 'Cube 'W 'G 'B 'W 'R 'R, + 'Cube 'R 'W 'R 'B 'G 'R, 'Cube 'B 'R 'G 'G 'W 'W], + '[ 'Cube 'G 'B 'R 'W 'B 'G, 'Cube 'R 'R 'W 'B 'G 'W, + 'Cube 'R 'G 'B 'R 'W 'R, 'Cube 'W 'W 'G 'G 'R 'B], + '[ 'Cube 'G 'W 'R 'B 'B 'G, 'Cube 'W 'B 'W 'R 'G 'R, + 'Cube 'R 'R 'B 'G 'W 'R, 'Cube 'B 'G 'G 'W 'R 'W], + '[ 'Cube 'G 'R 'W 'B 'B 'G, 'Cube 'R 'W 'B 'G 'R 'W, + 'Cube 'R 'B 'R 'W 'G 'R, 'Cube 'W 'G 'G 'R 'W 'B], + '[ 'Cube 'G 'R 'B 'B 'W 'G, 'Cube 'W 'W 'R 'G 'B 'R, + 'Cube 'R 'B 'G 'W 'R 'R, 'Cube 'B 'G 'W 'R 'G 'W], + '[ 'Cube 'G 'W 'B 'B 'R 'G, 'Cube 'R 'B 'G 'R 'W 'W, + 'Cube 'R 'R 'W 'G 'B 'R, 'Cube 'W 'G 'R 'W 'G 'B], + '[ 'Cube 'G 'B 'B 'W 'R 'G, 'Cube 'W 'R 'G 'B 'W 'R, + 'Cube 'R 'G 'W 'R 'B 'R, 'Cube 'B 'W 'R 'G 'G 'W], + '[ 'Cube 'G 'B 'B 'R 'W 'G, 'Cube 'R 'G 'R 'W 'B 'W, + 'Cube 'R 'W 'G 'B 'R 'R, 'Cube 'W 'R 'W 'G 'G 'B]])) arising from a use of ‘print’ In the expression: print (Proxy :: Proxy (Solutions Cubes)) In an equation for ‘main’: diff --git a/testsuite/tests/perf/compiler/T9872d.hs b/testsuite/tests/perf/compiler/T9872d.hs index 4930ffecfe..5c859eefdc 100644 --- a/testsuite/tests/perf/compiler/T9872d.hs +++ b/testsuite/tests/perf/compiler/T9872d.hs @@ -16,30 +16,32 @@ module T9872d where -- families. Code in this file was extracted from encoding generated -- automatically with Template Haskell by singletons library. +import Data.Kind import GHC.TypeLits -- encoding of type-level partially applied functions -data TyFun :: * -> * -> * -type family Apply (f :: TyFun k1 k2 -> *) (x :: k1) :: k2 +data TyFun :: Type -> Type -> Type +type family Apply (f :: TyFun k1 k2 -> Type) (x :: k1) :: k2 type a @@ b = Apply a b -- some boilerplate type family Error (a :: k) :: k1 type ErrorSym1 a = Error a -data ErrorSym0 :: TyFun a b -> * +data ErrorSym0 :: TyFun a b -> Type type instance Apply ErrorSym0 e = Error e data Proxy a = Proxy -data KProxy (a :: *) = KProxy +data KProxy (a :: Type) = KProxy type KindOf (a :: k) = ('KProxy :: KProxy k) -- type-level addition type (:+$$$) (t1 :: Nat) (t2 :: Nat) = t1 + t2 data (:+$$) (l :: Nat) (tf :: TyFun Nat Nat) - = forall a. (KindOf (Apply ((:+$$) l) a)) ~ (KindOf ((:+$$$) l a)) => (:+$$###) + = forall a. (KindOf (Apply ((:+$$) l) a)) ~ (KindOf ((:+$$$) l a)) => + (:+$$###) type instance Apply ((:+$$) l1) l2 = (:+$$$) l1 l2 -data (:+$) (l :: TyFun Nat (TyFun Nat Nat -> *)) +data (:+$) (l :: TyFun Nat (TyFun Nat Nat -> Type)) = forall a. (KindOf (Apply (:+$) a)) ~ (KindOf ((:+$$) a)) => (:+$###) type instance Apply (:+$) l = (:+$$) l @@ -49,10 +51,11 @@ type NilSym0 = '[] type ConsSym2 (x :: a) (xs :: [a]) = x ': xs data ConsSym1 (x :: a) (l_a3t6 :: TyFun [a] [a]) - = forall b. (KindOf (Apply (ConsSym1 x) b)) ~ (KindOf (ConsSym2 x b)) => (:$$###) + = forall b. (KindOf (Apply (ConsSym1 x) b)) ~ (KindOf (ConsSym2 x b)) => + (:$$###) type instance Apply (ConsSym1 x) xs = ConsSym2 x xs -data ConsSym0 (l :: TyFun a (TyFun [a] [a] -> *)) +data ConsSym0 (l :: TyFun a (TyFun [a] [a] -> Type)) = forall a. (KindOf (Apply ConsSym0 a)) ~ (KindOf (ConsSym1 a)) => (:$###) type instance Apply ConsSym0 l = ConsSym1 l @@ -63,22 +66,41 @@ data Let_1627403919Scrutinee_1627403894Sym3 l_a3Dx l_a3Dy l_a3Dz l_a3Dw - = forall arg_a3DA. (KindOf (Apply (Let_1627403919Scrutinee_1627403894Sym3 l_a3Dx l_a3Dy l_a3Dz) arg_a3DA)) ~ (KindOf (Let_1627403919Scrutinee_1627403894Sym4 l_a3Dx l_a3Dy l_a3Dz arg_a3DA)) => + = forall arg_a3DA. (KindOf (Apply (Let_1627403919Scrutinee_1627403894Sym3 + l_a3Dx l_a3Dy l_a3Dz) arg_a3DA)) ~ + (KindOf (Let_1627403919Scrutinee_1627403894Sym4 + l_a3Dx l_a3Dy l_a3Dz arg_a3DA)) => Let_1627403919Scrutinee_1627403894Sym3KindInference -type instance Apply (Let_1627403919Scrutinee_1627403894Sym3 l_a3Dx l_a3Dy l_a3Dz) l_a3Dw = Let_1627403919Scrutinee_1627403894Sym4 l_a3Dx l_a3Dy l_a3Dz l_a3Dw +type instance Apply (Let_1627403919Scrutinee_1627403894Sym3 + l_a3Dx l_a3Dy l_a3Dz) l_a3Dw = + Let_1627403919Scrutinee_1627403894Sym4 l_a3Dx l_a3Dy l_a3Dz l_a3Dw data Let_1627403919Scrutinee_1627403894Sym2 l_a3Dt l_a3Du l_a3Ds - = forall arg_a3Dv. (KindOf (Apply (Let_1627403919Scrutinee_1627403894Sym2 l_a3Dt l_a3Du) arg_a3Dv)) ~ (KindOf (Let_1627403919Scrutinee_1627403894Sym3 l_a3Dt l_a3Du arg_a3Dv)) => + = forall arg_a3Dv. (KindOf (Apply (Let_1627403919Scrutinee_1627403894Sym2 + l_a3Dt l_a3Du) arg_a3Dv)) ~ + (KindOf (Let_1627403919Scrutinee_1627403894Sym3 + l_a3Dt l_a3Du arg_a3Dv)) => Let_1627403919Scrutinee_1627403894Sym2KindInference -type instance Apply (Let_1627403919Scrutinee_1627403894Sym2 l_a3Dt l_a3Du) l_a3Ds = Let_1627403919Scrutinee_1627403894Sym3 l_a3Dt l_a3Du l_a3Ds +type instance Apply + (Let_1627403919Scrutinee_1627403894Sym2 l_a3Dt l_a3Du) l_a3Ds = + Let_1627403919Scrutinee_1627403894Sym3 l_a3Dt l_a3Du l_a3Ds data Let_1627403919Scrutinee_1627403894Sym1 l_a3Dq l_a3Dp - = forall arg_a3Dr. (KindOf (Apply (Let_1627403919Scrutinee_1627403894Sym1 l_a3Dq) arg_a3Dr)) ~ (KindOf (Let_1627403919Scrutinee_1627403894Sym2 l_a3Dq arg_a3Dr)) => + = forall arg_a3Dr. (KindOf (Apply (Let_1627403919Scrutinee_1627403894Sym1 + l_a3Dq) arg_a3Dr)) ~ + (KindOf (Let_1627403919Scrutinee_1627403894Sym2 + l_a3Dq arg_a3Dr)) => Let_1627403919Scrutinee_1627403894Sym1KindInference -type instance Apply (Let_1627403919Scrutinee_1627403894Sym1 l_a3Dq) l_a3Dp = Let_1627403919Scrutinee_1627403894Sym2 l_a3Dq l_a3Dp +type instance Apply (Let_1627403919Scrutinee_1627403894Sym1 l_a3Dq) + l_a3Dp + = Let_1627403919Scrutinee_1627403894Sym2 l_a3Dq l_a3Dp data Let_1627403919Scrutinee_1627403894Sym0 l_a3Dn - = forall arg_a3Do. (KindOf (Apply Let_1627403919Scrutinee_1627403894Sym0 arg_a3Do)) ~ (KindOf (Let_1627403919Scrutinee_1627403894Sym1 arg_a3Do)) => + = forall arg_a3Do. (KindOf (Apply Let_1627403919Scrutinee_1627403894Sym0 + arg_a3Do)) ~ + (KindOf (Let_1627403919Scrutinee_1627403894Sym1 + arg_a3Do)) => Let_1627403919Scrutinee_1627403894Sym0KindInference -type instance Apply Let_1627403919Scrutinee_1627403894Sym0 l_a3Dn = Let_1627403919Scrutinee_1627403894Sym1 l_a3Dn +type instance Apply Let_1627403919Scrutinee_1627403894Sym0 l_a3Dn + = Let_1627403919Scrutinee_1627403894Sym1 l_a3Dn type Let_1627403919Scrutinee_1627403894 f_a3Dd q0_a3De x_a3Df @@ -90,60 +112,154 @@ type family Case f q0 x xs t :: [k] where Case f q0 x xs (q ': qs) = ConsSym0 @@ (f @@ x @@ q) @@ (ConsSym0 @@ q @@ qs) -- type-level scanr -type ScanrSym3 (t1 :: TyFun a (TyFun b b -> *) -> *) (t2 :: b) (t3 :: [a]) = +type ScanrSym3 (t1 :: TyFun a (TyFun b b -> Type) -> Type) + (t2 :: b) + (t3 :: [a]) = Scanr t1 t2 t3 -data ScanrSym2 (l1 :: TyFun a (TyFun b b -> *) -> *) (l2 :: b) (l3 :: TyFun [a] [b]) - = forall a. (KindOf (Apply (ScanrSym2 l1 l2) a)) ~ (KindOf (ScanrSym3 l1 l2 a)) => +data ScanrSym2 (l1 :: TyFun a (TyFun b b -> Type) -> Type) + (l2 :: b) + (l3 :: TyFun [a] [b]) + = forall a. (KindOf (Apply (ScanrSym2 l1 l2) a)) ~ + (KindOf (ScanrSym3 l1 l2 a)) => ScanrSym2KindInference type instance Apply (ScanrSym2 l1 l2) l3 = ScanrSym3 l1 l2 l3 -data ScanrSym1 (l_a3D0 :: TyFun a_a3CJ (TyFun b_a3CK b_a3CK -> *) -> *) +data ScanrSym1 (l_a3D0 :: TyFun a_a3CJ (TyFun b_a3CK b_a3CK -> Type) -> Type) (l_a3CZ :: TyFun b_a3CK (TyFun ([a_a3CJ]) ([b_a3CK]) - -> *)) - = forall arg_a3D1. (KindOf (Apply (ScanrSym1 l_a3D0) arg_a3D1)) ~ (KindOf (ScanrSym2 l_a3D0 arg_a3D1)) => + -> Type)) + = forall arg_a3D1. (KindOf (Apply (ScanrSym1 l_a3D0) arg_a3D1)) ~ + (KindOf (ScanrSym2 l_a3D0 arg_a3D1)) => ScanrSym1KindInference type instance Apply (ScanrSym1 l_a3D0) l_a3CZ = ScanrSym2 l_a3D0 l_a3CZ -data ScanrSym0 (l :: TyFun (TyFun a (TyFun b b -> *) -> *) - (TyFun b (TyFun [a] [b] -> *) -> *)) +data ScanrSym0 (l :: TyFun (TyFun a (TyFun b b -> Type) -> Type) + (TyFun b (TyFun [a] [b] -> Type) -> Type)) = forall a. (KindOf (Apply ScanrSym0 a)) ~ (KindOf (ScanrSym1 a)) => ScanrSym0KindInference type instance Apply ScanrSym0 l1 = ScanrSym1 l1 -type family Scanr (a_a3D6 :: TyFun a_a3CJ (TyFun b_a3CK b_a3CK -> *) -> *) +type family Scanr (a_a3D6 :: TyFun a_a3CJ (TyFun b_a3CK b_a3CK -> Type) -> Type) (a_a3D7 :: b_a3CK) (a_a3D8 :: [a_a3CJ]) :: [b_a3CK] where Scanr _z_1627403911_a3Db q0_a3Dc '[] = Apply (Apply ConsSym0 q0_a3Dc) NilSym0 - Scanr f_a3Dd q0_a3De (x_a3Df ': xs_a3Dg) = Case f_a3Dd q0_a3De x_a3Df xs_a3Dg (Let_1627403919Scrutinee_1627403894Sym4 f_a3Dd q0_a3De x_a3Df xs_a3Dg) + Scanr f_a3Dd q0_a3De (x_a3Df ': xs_a3Dg) = + Case f_a3Dd q0_a3De x_a3Df xs_a3Dg (Let_1627403919Scrutinee_1627403894Sym4 + f_a3Dd q0_a3De x_a3Df xs_a3Dg) {- -foo32 :: Proxy ('[528,527,525,522,518,513,507,500,492,483,473,462,450,437,423,408,392,375,357,338,318,297,275,252,228,203,177,150,122,93,63,32,0]) +foo32 :: Proxy ('[528,527,525,522,518,513,507,500,492,483,473,462,450,437,423, + 408,392,375,357,338,318,297,275,252,228,203,177,150,122,93, + 63,32,0]) foo32 = Proxy -bar32 :: Proxy (ScanrSym0 @@ (:+$) @@ 0 @@ '[1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31,32]) +bar32 :: Proxy (ScanrSym0 @@ (:+$) @@ 0 @@ '[1,2,3,4,5,6,7,8,9,10,11,12,13,14, + 15,16,17,18,19,20,21,22,23,24,25, + 26,27,28,29,30,31,32]) bar32 = foo32 -} {- -foo64 :: Proxy ('[2080,2079,2077,2074,2070,2065,2059,2052,2044,2035,2025,2014,2002,1989,1975,1960,1944,1927,1909,1890,1870,1849,1827,1804,1780,1755,1729,1702,1674,1645,1615,1584,1552,1519,1485,1450,1414,1377,1339,1300,1260,1219,1177,1134,1090,1045,999,952,904,855,805,754,702,649,595,540,484,427,369,310,250,189,127,64,0]) +foo64 :: Proxy ('[2080,2079,2077,2074,2070,2065,2059,2052,2044,2035,2025,2014, + 2002,1989,1975,1960,1944,1927,1909,1890,1870,1849,1827,1804, + 1780,1755,1729,1702,1674,1645,1615,1584,1552,1519,1485,1450, + 1414,1377,1339,1300,1260,1219,1177,1134,1090,1045,999,952,904, + 855,805,754,702,649,595,540,484,427,369,310,250,189,127,64,0]) foo64 = Proxy -bar64 :: Proxy (ScanrSym0 @@ (:+$) @@ 0 @@ '[1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31,32,33,34,35,36,37,38,39,40,41,42,43,44,45,46,47,48,49,50,51,52,53,54,55,56,57,58,59,60,61,62,63,64]) +bar64 :: Proxy (ScanrSym0 @@ (:+$) @@ 0 @@ '[1,2,3,4,5,6,7,8,9,10,11,12,13,14, + 15,16,17,18,19,20,21,22,23,24,25, + 26,27,28,29,30,31,32,33,34,35,36, + 37,38,39,40,41,42,43,44,45,46,47, + 48,49,50,51,52,53,54,55,56,57,58, + 59,60,61,62,63,64]) bar64 = foo64 -foo128 :: Proxy ('[8256,8255,8253,8250,8246,8241,8235,8228,8220,8211,8201,8190,8178,8165,8151,8136,8120,8103,8085,8066,8046,8025,8003,7980,7956,7931,7905,7878,7850,7821,7791,7760,7728,7695,7661,7626,7590,7553,7515,7476,7436,7395,7353,7310,7266,7221,7175,7128,7080,7031,6981,6930,6878,6825,6771,6716,6660,6603,6545,6486,6426,6365,6303,6240,6176,6111,6045,5978,5910,5841,5771,5700,5628,5555,5481,5406,5330,5253,5175,5096,5016,4935,4853,4770,4686,4601,4515,4428,4340,4251,4161,4070,3978,3885,3791,3696,3600,3503,3405,3306,3206,3105,3003,2900,2796,2691,2585,2478,2370,2261,2151,2040,1928,1815,1701,1586,1470,1353,1235,1116,996,875,753,630,506,381,255,128,0]) +foo128 :: Proxy ('[8256,8255,8253,8250,8246,8241,8235,8228,8220,8211,8201,8190, + 8178,8165,8151,8136,8120,8103,8085,8066,8046,8025,8003,7980, + 7956,7931,7905,7878,7850,7821,7791,7760,7728,7695,7661,7626, + 7590,7553,7515,7476,7436,7395,7353,7310,7266,7221,7175,7128, + 7080,7031,6981,6930,6878,6825,6771,6716,6660,6603,6545,6486, + 6426,6365,6303,6240,6176,6111,6045,5978,5910,5841,5771,5700, + 5628,5555,5481,5406,5330,5253,5175,5096,5016,4935,4853,4770, + 4686,4601,4515,4428,4340,4251,4161,4070,3978,3885,3791,3696, + 3600,3503,3405,3306,3206,3105,3003,2900,2796,2691,2585,2478, + 2370,2261,2151,2040,1928,1815,1701,1586,1470,1353,1235,1116, + 996,875,753,630,506,381,255,128,0]) foo128 = Proxy -bar128 :: Proxy (ScanrSym0 @@ (:+$) @@ 0 @@ '[1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31,32,33,34,35,36,37,38,39,40,41,42,43,44,45,46,47,48,49,50,51,52,53,54,55,56,57,58,59,60,61,62,63,64,65,66,67,68,69,70,71,72,73,74,75,76,77,78,79,80,81,82,83,84,85,86,87,88,89,90,91,92,93,94,95,96,97,98,99,100,101,102,103,104,105,106,107,108,109,110,111,112,113,114,115,116,117,118,119,120,121,122,123,124,125,126,127,128]) +bar128 :: Proxy (ScanrSym0 @@ (:+$) @@ 0 @@ '[1,2,3,4,5,6,7,8,9,10,11,12,13,14, + 15,16,17,18,19,20,21,22,23,24,25, + 26,27,28,29,30,31,32,33,34,35,36, + 37,38,39,40,41,42,43,44,45,46,47, + 48,49,50,51,52,53,54,55,56,57,58, + 59,60,61,62,63,64,65,66,67,68,69, + 70,71,72,73,74,75,76,77,78,79,80, + 81,82,83,84,85,86,87,88,89,90,91, + 92,93,94,95,96,97,98,99,100,101, + 102,103,104,105,106,107,108,109, + 110,111,112,113,114,115,116,117, + 118,119,120,121,122,123,124,125, + 126,127,128]) bar128 = foo128 -} -foo256 :: Proxy ('[32896,32895,32893,32890,32886,32881,32875,32868,32860,32851,32841,32830,32818,32805,32791,32776,32760,32743,32725,32706,32686,32665,32643,32620,32596,32571,32545,32518,32490,32461,32431,32400,32368,32335,32301,32266,32230,32193,32155,32116,32076,32035,31993,31950,31906,31861,31815,31768,31720,31671,31621,31570,31518,31465,31411,31356,31300,31243,31185,31126,31066,31005,30943,30880,30816,30751,30685,30618,30550,30481,30411,30340,30268,30195,30121,30046,29970,29893,29815,29736,29656,29575,29493,29410,29326,29241,29155,29068,28980,28891,28801,28710,28618,28525,28431,28336,28240,28143,28045,27946,27846,27745,27643,27540,27436,27331,27225,27118,27010,26901,26791,26680,26568,26455,26341,26226,26110,25993,25875,25756,25636,25515,25393,25270,25146,25021,24895,24768,24640,24511,24381,24250,24118,23985,23851,23716,23580,23443,23305,23166,23026,22885,22743,22600,22456,22311,22165,22018,21870,21721,21571,21420,21268,21115,20961,20806,20650,20493,20335,20176,20016,19855,19693,19530,19366,19201,19035,18868,18700,18531,18361,18190,18018,17845,17671,17496,17320,17143,16965,16786,16606,16425,16243,16060,15876,15691,15505,15318,15130,14941,14751,14560,14368,14175,13981,13786,13590,13393,13195,12996,12796,12595,12393,12190,11986,11781,11575,11368,11160,10951,10741,10530,10318,10105,9891,9676,9460,9243,9025,8806,8586,8365,8143,7920,7696,7471,7245,7018,6790,6561,6331,6100,5868,5635,5401,5166,4930,4693,4455,4216,3976,3735,3493,3250,3006,2761,2515,2268,2020,1771,1521,1270,1018,765,511,256,0]) +foo256 :: Proxy ('[32896,32895,32893,32890,32886,32881,32875,32868,32860,32851, + 32841,32830,32818,32805,32791,32776,32760,32743,32725,32706, + 32686,32665,32643,32620,32596,32571,32545,32518,32490,32461, + 32431,32400,32368,32335,32301,32266,32230,32193,32155,32116, + 32076,32035,31993,31950,31906,31861,31815,31768,31720,31671, + 31621,31570,31518,31465,31411,31356,31300,31243,31185,31126, + 31066,31005,30943,30880,30816,30751,30685,30618,30550,30481, + 30411,30340,30268,30195,30121,30046,29970,29893,29815,29736, + 29656,29575,29493,29410,29326,29241,29155,29068,28980,28891, + 28801,28710,28618,28525,28431,28336,28240,28143,28045,27946, + 27846,27745,27643,27540,27436,27331,27225,27118,27010,26901, + 26791,26680,26568,26455,26341,26226,26110,25993,25875,25756, + 25636,25515,25393,25270,25146,25021,24895,24768,24640,24511, + 24381,24250,24118,23985,23851,23716,23580,23443,23305,23166, + 23026,22885,22743,22600,22456,22311,22165,22018,21870,21721, + 21571,21420,21268,21115,20961,20806,20650,20493,20335,20176, + 20016,19855,19693,19530,19366,19201,19035,18868,18700,18531, + 18361,18190,18018,17845,17671,17496,17320,17143,16965,16786, + 16606,16425,16243,16060,15876,15691,15505,15318,15130,14941, + 14751,14560,14368,14175,13981,13786,13590,13393,13195,12996, + 12796,12595,12393,12190,11986,11781,11575,11368,11160,10951, + 10741,10530,10318,10105,9891,9676,9460,9243,9025,8806, + 8586,8365,8143,7920,7696,7471,7245,7018,6790,6561,6331,6100, + 5868,5635,5401,5166,4930,4693,4455,4216,3976,3735,3493,3250, + 3006,2761,2515,2268,2020,1771,1521,1270,1018,765,511,256,0]) foo256 = Proxy -bar256 :: Proxy (ScanrSym0 @@ (:+$) @@ 0 @@ '[1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31,32,33,34,35,36,37,38,39,40,41,42,43,44,45,46,47,48,49,50,51,52,53,54,55,56,57,58,59,60,61,62,63,64,65,66,67,68,69,70,71,72,73,74,75,76,77,78,79,80,81,82,83,84,85,86,87,88,89,90,91,92,93,94,95,96,97,98,99,100,101,102,103,104,105,106,107,108,109,110,111,112,113,114,115,116,117,118,119,120,121,122,123,124,125,126,127,128,129,130,131,132,133,134,135,136,137,138,139,140,141,142,143,144,145,146,147,148,149,150,151,152,153,154,155,156,157,158,159,160,161,162,163,164,165,166,167,168,169,170,171,172,173,174,175,176,177,178,179,180,181,182,183,184,185,186,187,188,189,190,191,192,193,194,195,196,197,198,199,200,201,202,203,204,205,206,207,208,209,210,211,212,213,214,215,216,217,218,219,220,221,222,223,224,225,226,227,228,229,230,231,232,233,234,235,236,237,238,239,240,241,242,243,244,245,246,247,248,249,250,251,252,253,254,255,256]) +bar256 :: Proxy (ScanrSym0 @@ (:+$) @@ 0 @@ '[1,2,3,4,5,6,7,8,9,10,11,12,13,14, + 15,16,17,18,19,20,21,22,23,24,25, + 26,27,28,29,30,31,32,33,34,35,36, + 37,38,39,40,41,42,43,44,45,46,47, + 48,49,50,51,52,53,54,55,56,57,58, + 59,60,61,62,63,64,65,66,67,68,69, + 70,71,72,73,74,75,76,77,78,79,80, + 81,82,83,84,85,86,87,88,89,90,91, + 92,93,94,95,96,97,98,99,100,101, + 102,103,104,105,106,107,108,109, + 110,111,112,113,114,115,116,117, + 118,119,120,121,122,123,124,125, + 126,127,128,129,130,131,132,133, + 134,135,136,137,138,139,140,141, + 142,143,144,145,146,147,148,149, + 150,151,152,153,154,155,156,157, + 158,159,160,161,162,163,164,165, + 166,167,168,169,170,171,172,173, + 174,175,176,177,178,179,180,181, + 182,183,184,185,186,187,188,189, + 190,191,192,193,194,195,196,197, + 198,199,200,201,202,203,204,205, + 206,207,208,209,210,211,212,213, + 214,215,216,217,218,219,220,221, + 222,223,224,225,226,227,228,229, + 230,231,232,233,234,235,236,237, + 238,239,240,241,242,243,244,245, + 246,247,248,249,250,251,252,253, + 254,255,256]) bar256 = foo256 - diff --git a/testsuite/tests/perf/compiler/all.T b/testsuite/tests/perf/compiler/all.T index 03892714c7..7420690232 100644 --- a/testsuite/tests/perf/compiler/all.T +++ b/testsuite/tests/perf/compiler/all.T @@ -39,7 +39,7 @@ test('T1969', # 2013-11-13 17 (x86/Windows, 64bit machine) # 2015-07-11 21 (x86/Linux, 64bit machine) use +RTS -G1 # 2016-04-06 30 (x86/Linux, 64bit machine) - (wordsize(64), 61, 20)]), + (wordsize(64), 73, 20)]), # 28 (amd64/Linux) # 34 (amd64/Linux) # 2012-09-20 23 (amd64/Linux) @@ -55,6 +55,8 @@ test('T1969', # See the comment 16 on #8472. # 2017-02-17 83 (amd64/Linux) Type-indexed Typeable # 2017-03-31 61 (amd64/Linux) Fix memory leak in simplifier + # 2018-01-25 78 (amd64/Linux) Use CoreExpr for EvTerm + # 2018-07-10 73 (amd64/Linux) Fix space leaks compiler_stats_num_field('max_bytes_used', [(platform('i386-unknown-mingw32'), 5719436, 20), # 2010-05-17 5717704 (x86/Windows) @@ -72,7 +74,7 @@ test('T1969', # 2017-03-24 9261052 (x86/Linux, 64-bit machine) # 2017-04-06 9418680 (x86/Linux, 64-bit machine) - (wordsize(64), 16679176, 15)]), + (wordsize(64), 19738608, 15)]), # 2014-09-10 10463640, 10 # post-AMP-update (somewhat stabelish) # looks like the peak is around ~10M, but we're # unlikely to GC exactly on the peak. @@ -87,6 +89,9 @@ test('T1969', # 2017-02-01 19924328 (amd64/Linux) Join points (#12988) # 2017-02-14 16393848 Early inline patch # 2017-03-31 16679176 Fix memory leak in simplifier + # 2017-08-25 19199872 Refactor the Mighty Simplifier + # 2018-02-19 22311600 (amd64/Linux) Unknown + # 2018-07-10 19738608 (amd64/Linux) Fix space leaks compiler_stats_num_field('bytes allocated', [(platform('i386-unknown-mingw32'), 301784492, 5), @@ -105,7 +110,7 @@ test('T1969', # 2015-07-11 288699104 (x86/Linux, 64-bit machine) use +RTS -G1 # 2016-04-06 344730660 (x86/Linux, 64-bit machine) # 2017-03-24 324586096 (x86/Linux, 64-bit machine) - (wordsize(64), 659863176, 5)]), + (wordsize(64), 670839456, 5)]), # 2009-11-17 434845560 (amd64/Linux) # 2009-12-08 459776680 (amd64/Linux) # 2010-05-17 519377728 (amd64/Linux) @@ -129,6 +134,7 @@ test('T1969', # 2017-02-17 831733376 (x86_64/Linux) Type-indexed Typeable # 2017-02-25 695354904 (x86_64/Linux) Early inlining patch # 2017-04-21 659863176 (x86_64/Linux) Unknown + # 2018-07-10 670839456 (x86_64/Linux) Unknown (just updating) only_ways(['normal']), extra_hc_opts('-dcore-lint -static'), @@ -196,7 +202,7 @@ test('T3294', # 2013-11-13: 1478325844 (x86/Windows, 64bit machine) # 2014-01-12: 1565185140 (x86/Linux) # 2013-04-04: 1377050640 (x86/Windows, 64bit machine) - (wordsize(64), 2253557280, 5)]), + (wordsize(64), 1858491504, 5)]), # old: 1357587088 (amd64/Linux) # 29/08/2012: 2961778696 (amd64/Linux) # (^ increase due to new codegen, see #7198) @@ -211,6 +217,7 @@ test('T3294', # 2016-07-11: 2739731144 (Windows) after fix for #12227 (ignoring) # 2017-02-17: 2758641264 (amd64/Linux) (Type indexed Typeable) # 2017-05-14: 2253557280 (amd64/Linux) Two-pass CmmLayoutStack + # 2017-10-24: 1858491504 (amd64/Linux) Improved linear regAlloc conf_3294, # Use `+RTS -G1` for more stable residency measurements. Note [residency]. @@ -333,7 +340,7 @@ test('T3064', # 2016-04-06: 153261024 (x86/Linux) probably wildcard refactor # 2017-03-24: 134044092 (x86/Linux, 64-bit machine) Update - (wordsize(64), 281509496, 5)]), + (wordsize(64), 272759920, 5)]), # (amd64/Linux) (2011-06-28): 73259544 # (amd64/Linux) (2013-02-07): 224798696 # (amd64/Linux) (2013-08-02): 236404384, increase from roles @@ -360,6 +367,8 @@ test('T3064', # (amd64/Linux) (2017-02-14): 259815560 Early inline patch: 9% improvement # (amd64/Linux) (2017-03-31): 265950920 Fix memory leak in simplifier # (amd64/Linux) (2017-05-01): 281509496 Avoid excessive space usage from unfoldings in CoreTidy + # (amd64/Linux) (2017-05-01): 258505536 I think this is improvement in coercionKind e4ab65bd + # (amd64/Linux) (2018-08-04): 272759920 It's unclear ################################### # deactivated for now, as this metric became too volatile recently @@ -444,7 +453,7 @@ test('T5631', # 2014-04-04: 346389856 (x86 Windows, 64 bit machine) # 2014-12-01: 390199244 (Windows laptop) # 2016-04-06: 570137436 (amd64/Linux) many reasons - (wordsize(64), 1037482512, 5)]), + (wordsize(64), 1161885448, 5)]), # expected value: 774595008 (amd64/Linux): # expected value: 735486328 (amd64/Linux) 2012/12/12: # expected value: 690742040 (amd64/Linux) Call Arity improvements @@ -459,6 +468,9 @@ test('T5631', # 2017-02-17: 1517484488 (amd64/Linux) Type-indexed Typeable # 2017-03-03: 1065147968 (amd64/Linux) Share Typeable KindReps # 2017-03-31: 1037482512 (amd64/Linux) Fix memory leak in simplifier + # 2017-07-27: 1106015512 (Mac) Regresssion from tracking visibility in TypeEqOrigin + # should be fixed by #14037 + # 2018-06-18: 1161885448 (Mac) Not entirely clear only_ways(['normal']) ], compile, @@ -469,11 +481,13 @@ test('parsing001', [(wordsize(32), 232777056, 10), # Initial: 274000576 # 2017-03-24: 232777056 - (wordsize(64), 463931280, 5)]), + (wordsize(64), 519401296, 5)]), # expected value: 587079016 (amd64/Linux) # 2016-09-01: 581551384 (amd64/Linux) Restore w/w limit (#11565) # 2016-12-19: 493730288 (amd64/Linux) Join points (#12988) # 2017-02-14: 463931280 Early inlining patch; acutal improvement 7% + # 2017-12-11: 490228304 BlockArguments + # 2018-04-09: 519401296 Inexplicable, collateral of #14737 only_ways(['normal']), ], compile_fail, ['']) @@ -493,7 +507,7 @@ test('T783', # 2016-04-06: 249332816 (x86/Linux, 64-bit machine) # 2017-03-24: 225911912 (x86/Linux, 64-bit machine) - (wordsize(64), 436978192, 10)]), + (wordsize(64), 481875416, 10)]), # prev: 349263216 (amd64/Linux) # 07/08/2012: 384479856 (amd64/Linux) # 29/08/2012: 436927840 (amd64/Linux) @@ -523,6 +537,7 @@ test('T783', # 2016-02-03: 488592288 (amd64/Linux) # (D1795: Another overhaul of pattern match checker, #11374) # 2017-02-14 436978192 Early inlining: 5% improvement + # 2017-09-08 481875416 Unknown extra_hc_opts('-static') ], @@ -540,7 +555,10 @@ test('T5321Fun', # 2016-04-06: 279922360 x86/Linux # 2017-03-24: 244387620 x86/Linux (64-bit machine) - (wordsize(64), 449577856, 5)]) + (platform('x86_64-apple-darwin'), 446893600, 5), + # 2018-03-17: 423774560 # OS X-only (reason unknown, see #11753) + + (wordsize(64), 423774560, 5)]) # prev: 585521080 # 2012-08-29: 713385808 # (increase due to new codegen) # 2013-05-15: 628341952 # (reason for decrease unknown) @@ -567,6 +585,7 @@ test('T5321Fun', # 2017-02-23: 524706256 # Type-indexed Typeable? (on Darwin) # 2017-02-25: 488295304 # Early inlining patch # 2017-05-14: 449577856 # (amd64/Linxu) Two-pass CmmLayoutStack + # 2017-12-13: 423774560 # (amd64/Linxu) Typechecker improvements ], compile,['']) @@ -581,7 +600,7 @@ test('T5321FD', # (due to better optCoercion, 5e7406d9, #9233) # 2016-04-06: 250757460 (x86/Linux) - (wordsize(64), 415136648, 10)]) + (wordsize(64), 371826136, 10)]) # prev: 418306336 # 29/08/2012: 492905640 # (increase due to new codegen) @@ -603,6 +622,7 @@ test('T5321FD', # 2016-07-16: 477840432 # Optimize handling of built-in OccNames # 2017-05-14: 415136648 (amd64/Linux) Two-pass CmmLayoutStack + # 2018-04-24: 371826136 (amd64/Linux) Store size in LitString ], compile,['']) @@ -650,11 +670,12 @@ test('T5837', # 2016-04-06: 24199320 (x86/Linux, 64-bit machine) TypeInType # 2017-03-24: 27028956 (x86/Linux, 64-bit machine) - (platform('x86_64-unknown-mingw32'), 59161648, 7), + (platform('x86_64-unknown-mingw32'), 54793816, 7), # 2017-02-19 59161648 (x64/Windows) - Unknown # 2017-04-21 54985248 (x64/Windows) - Unknown + # 2017-12-24 54793816 (x64/Windows) - Unknown - (wordsize(64), 52625920, 7)]) + (wordsize(64), 55813608, 7)]) # sample: 3926235424 (amd64/Linux, 15/2/2012) # 2012-10-02 81879216 # 2012-09-20 87254264 amd64/Linux @@ -690,6 +711,9 @@ test('T5837', # 2017-02-20 58648600 amd64/Linux Type-indexed Typeable # 2017-02-28 54151864 amd64/Linux Likely drift due to recent simplifier improvements # 2017-02-25 52625920 amd64/Linux Early inlining patch + # 2017-09-06 56782344 amd64/Linux Drift manifest in unrelated LLVM patch + # 2017-10-24 52089424 amd64/linux Fix space leak in BinIface.getSymbolTable + # 2018-02-19 55813608 amd64/Linux Unknown ], compile, ['-freduction-depth=50']) @@ -704,7 +728,7 @@ test('T6048', # 2014-12-01: 49987836 (x86 Windows) # 2016-04-06: 55701280 (x86/Linux, 64-bit machine) - (wordsize(64), 90996312, 10)]) + (wordsize(64), 100574504, 10)]) # 2012-09-18 97247032 amd64/Linux # 2014-01-16 108578664 amd64/Linux (unknown, likely foldl-via-foldr) # 2014-01-18 95960720 amd64/Linux Call Arity improvements @@ -717,7 +741,8 @@ test('T6048', # 2016-03-11 108225624 amd64/Linux unknown reason sadly; likely gradual creep. # 2016-11-25 94327392 amd64/Linux Back down again hooray; still not sure why # 2017-02-17 115715592 amd64/Linux Type-indexed Typeable - # 2017-04-28 90996312 Join point refactoring + # 2017-04-28 90996312 Join point refactoring + # 2018-06-18 100574504 Darwin Unclear ], compile,['']) @@ -729,7 +754,7 @@ test('T9020', # 2014-07-31: 343005716 (Windows) (general round of updates) # 2017-03-24: 249904136 (x86/Linux, 64-bit machine) - (wordsize(64), 423163832, 10)]) + (wordsize(64), 391876936, 10)]) # prev: 795469104 # 2014-07-17: 728263536 (general round of updates) # 2014-09-10: 785871680 post-AMP-cleanup @@ -743,13 +768,15 @@ test('T9020', # Program size collapses in first simplification # 2017-03-31: 493596312 Fix memory leak in simplifier # 2017-04-28: 423163832 Remove exponential behaviour in simplifier + # 2018-04-09: 562206104 Inexplicable, collateral of #14737 + # 2018-05-14: 391876936 Improved simplCast performance #15019 ], compile,['']) test('T9675', [ only_ways(['optasm']), compiler_stats_num_field('max_bytes_used', # Note [residency] - [(wordsize(64), 17675240, 15), + [(wordsize(64), 20499224, 15), # 2014-10-13 29596552 # 2014-10-13 26570896 seq the DmdEnv in seqDmdType as well # 2014-10-13 18582472 different machines giving different results.. @@ -760,12 +787,13 @@ test('T9675', # 2016-03-14 38776008 Final demand analyzer run # 2016-04-01 29871032 Fix leaks in demand analysis # 2016-04-30 17675240 Fix leaks in tidy unfoldings + # 2018-09-21 20499224 See #15663 (wordsize(32), 18043224, 15) # 2015-07-11 15341228 (x86/Linux, 64-bit machine) use +RTS -G1 # 2016-04-06 18043224 (x86/Linux, 64-bit machine) ]), compiler_stats_num_field('peak_megabytes_allocated', # Note [residency] - [(wordsize(64), 63, 15), + [(wordsize(64), 75, 15), # 2014-10-13 66 # 2014-10-13 58 seq the DmdEnv in seqDmdType as well # 2014-10-13 49 different machines giving different results... @@ -777,6 +805,7 @@ test('T9675', # 2016-04-14 144 Final demand analyzer run # 2016-07-26 121 Unboxed sums? # 2017-04-30 63 Fix leaks in tidy unfoldings + # 2018-09-21 75 See #15663 (wordsize(32), 56, 15) # 2015-07-11 56 (x86/Linux, 64-bit machine) use +RTS -G1 ]), @@ -802,7 +831,7 @@ test('T9675', test('T9872a', [ only_ways(['normal']), compiler_stats_num_field('bytes allocated', - [(wordsize(64), 3005891848, 5), + [(wordsize(64), 2729927408, 5), # 2014-12-10 5521332656 Initally created # 2014-12-16 5848657456 Flattener parameterized over roles # 2014-12-18 2680733672 Reduce type families even more eagerly @@ -811,6 +840,7 @@ test('T9872a', # 2016-10-19 3134866040 Refactor traceRn interface (#12617) # 2017-02-17 3298422648 Type-indexed Typeable # 2017-02-25 3005891848 Early inlining patch + # 2018-03-26 2729927408 Flattener update with optimizations (#12919) (wordsize(32), 1493198244, 5) # was 1325592896 @@ -845,7 +875,7 @@ test('T9872b', test('T9872c', [ only_ways(['normal']), compiler_stats_num_field('bytes allocated', - [(wordsize(64), 3404346032, 5), + [(wordsize(64), 3096670112, 5), # 2014-12-10 5495850096 Initally created # 2014-12-16 5842024784 Flattener parameterized over roles # 2014-12-18 2963554096 Reduce type families even more eagerly @@ -854,6 +884,7 @@ test('T9872c', # 2016-04-06: 4306667256 Refactoring of CSE #11781 # 2016-09-15: 3702580928 Fixing #12422 # 2017-02-14 3404346032 Early inlining: 5% improvement + # 2018-03-25 3096670112 Flattener patch with optimizations (#12919) (wordsize(32), 1727582260, 5) # was 1500000000 @@ -866,7 +897,7 @@ test('T9872c', test('T9872d', [ only_ways(['normal']), compiler_stats_num_field('bytes allocated', - [(wordsize(64), 462817352, 5), + [(wordsize(64), 578498120, 5), # 2014-12-18 796071864 Initally created # 2014-12-18 739189056 Reduce type families even more eagerly # 2015-01-07 687562440 TrieMap leaf compression @@ -879,6 +910,9 @@ test('T9872d', # 2017-02-17 535565128 Type-indexed Typeable # 2017-02-25 498855104 Early inlining # 2017-03-03 462817352 Share Typeable KindReps + # 2018-03-25 526485920 Flattener patch does more work (#12919) + # 2018-04-11 572537984 simplCast improvement collateral (#11735) + # 2018-07-04 578498120 introduce GRefl (#15192) (wordsize(32), 232954000, 5) # some date 328810212 @@ -917,7 +951,7 @@ test('T9961', test('T9233', [ only_ways(['normal']), compiler_stats_num_field('bytes allocated', - [(wordsize(64), 924299320, 5), + [(wordsize(64), 973149832, 5), # 2015-08-04 999826288 initial value # 2016-04-14 1066246248 Final demand analyzer run # 2016-06-18 984268712 shuffling around of Data.Functor.Identity @@ -929,6 +963,7 @@ test('T9233', # 2017-02-07 884436192 Another improvement to SetLevels # 2017-02-17 974530192 Type-indexed Typeable # 2017-03-21 924299320 It's unclear + # 2018-06-09 973149832 It's unclear (wordsize(32), 460112888, 5) # 2016-04-06 515672240 (x86/Linux) initial value @@ -1001,12 +1036,14 @@ test('T10547', test('T12227', [ only_ways(['normal']), compiler_stats_num_field('bytes allocated', - [(wordsize(64), 1060158624, 5), + [(wordsize(64), 752214784, 5), # 2016-07-11 5650186880 (Windows) before fix for #12227 # 2016-07-11 1822822016 (Windows) after fix for #12227 # 2016-12-20 1715827784 after d250d493 (INLINE in Traversable dms) # (or thereabouts in the commit history) # 2017-02-14 1060158624 Early inlining: 35% improvement + # 2018-01-04 812869424 Drop unused givens (#13032): 23% better + # 2018-06-27 752214784 Trac #15421 ]), ], compile, @@ -1016,13 +1053,17 @@ test('T12227', test('T12425', [ only_ways(['optasm']), compiler_stats_num_field('bytes allocated', - [(wordsize(64), 127500136, 5), + [(wordsize(64), 139100464, 5), # initial: 125831400 # 2017-01-18: 133380960 Allow top-level string literals in Core # 2017-02-17: 153611448 Type-indexed Typeable # 2017-03-03: 142256192 Share Typeable KindReps # 2017-03-21: 134334800 Unclear # 2017-04-28: 127500136 Remove exponential behaviour in simplifier + # 2017-05-23: 134780272 Addition of llvm-targets in dynflags (D3352) + # 2018-04-15: 141952368 Collateral of #14737 + # 2018-04-26: 150743648 Do not unpack class dictionaries with INLINABLE + # 2018-05-14: 139100464 improved simplCast performance #15019 ]), ], compile, @@ -1035,13 +1076,16 @@ test('T12234', # initial: 83032768 # 2017-02-19 89180624 (x64/Windows) - Unknown # 2017-02-25 79889200 (x64/Windows) - Early inline patch - (wordsize(64), 80245640, 5), + # 2018-05-04 86938328 (x64/Windows) - Unknown and horrible + (wordsize(64), 85961968, 5), # initial: 72958288 # 2016-01-17: 76848856 (x86-64, Linux. drift?) # 2017-02-01: 80882208 (Use superclass instances when solving) # 2017-02-05: 74374440 (Probably OccAnal fixes) # 2017-02-17: 86525344 (Type-indexed Typeable) # 2017-02-25: 83032768 (Early inline patch) + # 2017-09-07: 81696664 (Semigroup=>Monoid patch, D3927) + # 2018-04-26: 85961968 (Do not unpack class dictionaries with INLINABLE) ]), ], compile, @@ -1050,8 +1094,9 @@ test('T12234', test('T12545', [ only_ways(['normal']), compiler_stats_num_field('bytes allocated', - [(wordsize(64), 3538652464, 5), + [(wordsize(64), 3249613688, 5), # 2017-06-08 3538652464 initial + # 2018-06-27 3249613688 Trac #15421 ]), extra_clean(['T12545a.hi', 'T12545a.o']) ], @@ -1061,7 +1106,7 @@ test('T12545', test('T13035', [ only_ways(['normal']), compiler_stats_num_field('bytes allocated', - [(wordsize(64), 118665640, 5), + [(wordsize(64), 125020728, 5), # 2017-01-05 90595208 initial # 2017-01-19 95269000 Allow top-level string literals in Core # 2017-02-05 88806416 Probably OccAnal fixes @@ -1069,6 +1114,7 @@ test('T13035', # 2017-02-25 98390488 Early inline patch # 2017-03-21 93249744 It's unclear # 2017-07-19 118665640 Generate Typeable bindings for data instances + # 2018-06-10 125020728 It's unclear ]), ], compile, @@ -1091,7 +1137,7 @@ test('T13056', test('T12707', [ compiler_stats_num_field('bytes allocated', - [(wordsize(64), 1163821528, 5), + [(wordsize(64), 1201750816, 5), # initial: 1271577192 # 2017-01-22: 1348865648 Allow top-level strings in Core # 2017-01-31: 1280336112 Join points (#12988) @@ -1099,11 +1145,28 @@ test('T12707', # 2017-02-23: 1386110512 Type-indexed Typeable? (on Darwin) # 2017-03-02: 1231809592 Drift from recent simplifier improvements # 2017-05-14: 1163821528 (amd64/Linux) Two-pass CmmLayoutStack + # 2018-04-09: 1237898376 Inexplicable, collateral of #14737 + # 2018-04-30: 1141555816 improved simplCast performance #15019 + # 2018-09-21: 1201750816 (amd64/darwin) Drift ]), ], compile, ['']) +test('T12150', + [ only_ways(['optasm']), + compiler_stats_num_field('bytes allocated', + [(wordsize(64), 77557800, 5) + # initial: 70773000 + # 2017-08-25: 74358208 Refactor the Mighty Simplifier + # 2017-08-25: 78300680 Drift + # 2017-10-25: 73769936 amd64/linux Fix space leak in BinIface.getSymbolTable + # 2018-04-26: 77557800 Do not unpack class dictionaries with INLINABLE + ]), + ], + compile, + ['']) + test('T13379', [ compiler_stats_num_field('bytes allocated', [(platform('x86_64-apple-darwin'), 453166912, 10), @@ -1118,29 +1181,67 @@ test('T13379', test('MultiLayerModules', [ compiler_stats_num_field('bytes allocated', - [(wordsize(64), 6294813000, 10), + [(wordsize(64), 5619893176, 10), # initial: 12139116496 # 2017-05-12: 6956533312 Revert "Use a deterministic map for imp_dep_mods" # 2017-05-31: 6294813000 Faster checkFamInstConsistency + # 2018-01-21: 5619893176 Allocate less in plus_mod_dep ]), pre_cmd('./genMultiLayerModules'), extra_files(['genMultiLayerModules']), + compile_timeout_multiplier(5) + # this is _a lot_ + # but this test has been failing every now and then, + # especially on i386. Let's just give it some room + # to complete successfully reliably everywhere. ], multimod_compile, ['MultiLayerModules', '-v0']) +test('ManyConstructors', + [ compiler_stats_num_field('bytes allocated', + [(wordsize(64), 4246959352, 10), + # initial: 8130527160 + # 2018-01-05: 4246959352 Lift constructor tag allocation out of a loop + ]), + pre_cmd('./genManyConstructors'), + extra_files(['genManyConstructors']), + ], + multimod_compile, + ['ManyConstructors', '-v0']) + +test('ManyAlternatives', + [ compiler_stats_num_field('bytes allocated', + [(wordsize(64), 1398898072, 10), + # initial: 1756999240 + # 2018-01-20: 1398898072 Use IntSet in Dataflow + ]), + pre_cmd('./genManyAlternatives'), + extra_files(['genManyAlternatives']), + ], + multimod_compile, + ['ManyAlternatives', '-v0']) + test('T13701', [ compiler_stats_num_field('bytes allocated', - [(platform('x86_64-apple-darwin'), 2217187888, 10), - (platform('x86_64-unknown-linux'), 2133380768, 10), + [(platform('x86_64-apple-darwin'), 2549206272, 10), + (platform('x86_64-unknown-linux'), 2413253392, 10), # initial: 2511285600 # 2017-06-23: 2188045288 treat banged variable bindings as FunBinds # 2017-07-11: 2187920960 # 2017-07-12: 2412223768 inconsistency between Ben's machine and Harbormaster? # 2017-07-17: 2133380768 Resolved the issue causing the inconsistencies in this test + # 2018-05-09: 2413253392 D4659 (Fix GHCi space leaks) added + # some strictness which causes some extra + # work to be done in this test. ]), pre_cmd('./genT13701'), extra_files(['genT13701']), + compile_timeout_multiplier(4) + # 4 is _a lot_ (timeout after 1200s), + # but this test has been failing every now and then, + # especially on i386. Let's just give it some room + # to complete successfully reliably everywhere. ], multimod_compile, ['T13701', '-v0']) @@ -1153,26 +1254,75 @@ test('T13719', ]), pre_cmd('./genT13719'), extra_files(['genT13719']), + compile_timeout_multiplier(2) + # 2 is _a lot_ (timeout after 600s, to build 600 modules), + # but this test has been failing every now and then, + # especially on i386. Let's just give it some room + # to complete successfully reliably everywhere. ], multimod_compile, ['T13719', '-v0']) +test('T14697', + [ compiler_stats_num_field('bytes allocated', + [(wordsize(64), 371030912, 10), + # initial: 635573784 + # 2018-02-23: 337290376 Cache the fingerprint of sOpt_P + # 2018-05-24: 371030912 Unknown + ]), + # This generates too large of a command-line for poor Windows + when(opsys('mingw32'), expect_broken(15072)), + pre_cmd('./genT14697'), + extra_files(['genT14697']), + extra_hc_opts('$(cat T14697-flags)'), # 10k -optP arguments + ], + multimod_compile, + ['T14697', '-v0']) + +test('T14683', + [ compiler_stats_num_field('bytes allocated', + [(wordsize(64), 10521594688, 10), + # initial: 25189145632 + # 2018-04-19: 14675353056 Cache NthCo role (#14683) + # 2018-04-20: 10521594688 Remove unnecessary check in simplCast + ]), + ], + multimod_compile, + ['T14683', '-v0']) + test('Naperian', [ reqlib('vector'), only_ways(['optasm']), compiler_stats_num_field('bytes allocated', - [(wordsize(64), 2381935784, 10)]) + [(platform('x86_64-unknown-mingw32'), 54116696, 10), + # 2017-12-24 54116696 (x64/Windows) - Unknown + (wordsize(64), 53576760, 10)]) + # 2018-01-25 53576760 (x64/Linux) - The previous value looked very wrong ], compile, ['']) test ('T9630', [ compiler_stats_num_field('max_bytes_used', # Note [residency] - [(wordsize(64), 41568168, 15) + [(platform('x86_64-unknown-mingw32'), 39867088, 15), + # 2017-12-24: 34171816 (x64/Windows) + (wordsize(64), 41365088, 15) # initial: 56955240 # 2017-06-07: 41568168 Stop the specialiser generating loopy code + # 2018-02-25: 35324712 It's not entirely clear + # 2018-09-22: 41365088 It's not entirely clear (x86_64/darwin) ]), extra_clean(['T9630a.hi', 'T9630a.o']) ], multimod_compile, ['T9630', '-v0 -O']) + +test ('T15164', + [ compiler_stats_num_field('bytes allocated', + [(wordsize(64), 1945564312, 10) + # initial: 3423873408 + # 2018-05-22: 1945564312 Fix bottleneck in CallArity + ]) + ], + compile, + ['-v0 -O']) diff --git a/testsuite/tests/perf/compiler/genManyAlternatives b/testsuite/tests/perf/compiler/genManyAlternatives new file mode 100755 index 0000000000..1035425bd4 --- /dev/null +++ b/testsuite/tests/perf/compiler/genManyAlternatives @@ -0,0 +1,34 @@ +SIZE=1000 +MODULE=ManyAlternatives + +# Generates a module with a large number of alternatives that looks +# like this: +# +# module ManyAlternatives where +# +# data A1000 = A0 +# | A0001 +# | A0002 +# ... +# | A1000 +# +# f :: A -> Int +# f A0001 = 1990001 +# f A0002 = 1990002 +# ... +# f A1000 = 1991000 +# +# The point of this test is to check if we don't regress on #14667 reintroducing +# some code that's quadratic in the number of alternatives. + +echo "module $MODULE where" > $MODULE.hs +echo >> $MODULE.hs +echo "data A$SIZE = A0" >> $MODULE.hs +for i in $(seq -w 1 $SIZE); do + echo " | A$i" >> $MODULE.hs +done +echo >> $MODULE.hs +echo "f :: A$SIZE -> Int" >> $MODULE.hs +for i in $(seq -w 1 $SIZE); do + echo "f A$i = 199$i" >> $MODULE.hs +done diff --git a/testsuite/tests/perf/compiler/genManyConstructors b/testsuite/tests/perf/compiler/genManyConstructors new file mode 100755 index 0000000000..ec4abdced7 --- /dev/null +++ b/testsuite/tests/perf/compiler/genManyConstructors @@ -0,0 +1,25 @@ +SIZE=10000 +MODULE=ManyConstructors + +# Generates a module with a large number of constructors that looks +# like this: +# +# module ManyConstructors where +# +# data A10000 = A0 +# | A00001 +# | A00002 +# ... +# | A10000 +# +# The point of this test is to check if we don't regress on #14657 reintroducing +# some code that's quadratic in the number of constructors in a data type. +# NB. This is not that artificial, I've seen data types of this size +# in the wild. + +echo "module $MODULE where" > $MODULE.hs +echo >> $MODULE.hs +echo "data A$SIZE = A0" >> $MODULE.hs +for i in $(seq -w 1 $SIZE); do + echo " | A$i" >> $MODULE.hs +done diff --git a/testsuite/tests/perf/compiler/genMultiLayerModules b/testsuite/tests/perf/compiler/genMultiLayerModules index b98c481166..8220c0889f 100755 --- a/testsuite/tests/perf/compiler/genMultiLayerModules +++ b/testsuite/tests/perf/compiler/genMultiLayerModules @@ -1,4 +1,4 @@ -#!/bin/bash +#!/usr/bin/env bash # Generate $DEPTH layers of modules with $WIDTH modules on each layer # Every module on layer N imports all the modules on layer N-1 # MultiLayerModules.hs imports all the modules from the last layer diff --git a/testsuite/tests/perf/compiler/genT13701 b/testsuite/tests/perf/compiler/genT13701 index f2b7c4eab2..7401cdd27e 100755 --- a/testsuite/tests/perf/compiler/genT13701 +++ b/testsuite/tests/perf/compiler/genT13701 @@ -1,4 +1,5 @@ -#!/bin/bash +#!/usr/bin/env bash + # Generate $DEPTH layers of modules with $WIDTH modules on each layer # Every module on layer N imports all the modules on layer N-1 # MultiLayerModules.hs imports all the modules from the last layer diff --git a/testsuite/tests/perf/compiler/genT13719 b/testsuite/tests/perf/compiler/genT13719 index ccc078efd7..886fdd12c7 100755 --- a/testsuite/tests/perf/compiler/genT13719 +++ b/testsuite/tests/perf/compiler/genT13719 @@ -1,4 +1,5 @@ -#!/bin/bash +#!/usr/bin/env bash + # Generate $DEPTH layers of modules with $WIDTH modules on each layer # Every module on layer N imports all the modules on layer N-1 # $ROOT.hs imports all the modules from the last layer diff --git a/testsuite/tests/perf/compiler/genT14697 b/testsuite/tests/perf/compiler/genT14697 new file mode 100755 index 0000000000..73e8e93932 --- /dev/null +++ b/testsuite/tests/perf/compiler/genT14697 @@ -0,0 +1,17 @@ +#!/usr/bin/env bash +SIZE=100 +ROOT=T14697 +# Generates 100 empty modules and T14697 that imports them all +# It (along with the command line arguments) reproduces a problem where +# -optP command line flags would be hashed once per file +for i in $(seq -w 1 $SIZE); do + echo "module A$i where" > A$i.hs +done + +echo "module ${ROOT} where" > $ROOT.hs +for i in $(seq -w 1 $SIZE); do + echo "import A$i" >> $ROOT.hs; +done + +# generate flags +echo -optP-D__F{1..10000}__ > T14697-flags diff --git a/testsuite/tests/perf/compiler/parsing001.stderr b/testsuite/tests/perf/compiler/parsing001.stderr index d24d77539b..8293a1acd1 100644 --- a/testsuite/tests/perf/compiler/parsing001.stderr +++ b/testsuite/tests/perf/compiler/parsing001.stderr @@ -1,4 +1,4 @@ parsing001.hs:3:1: error: Could not find module ‘Wibble’ - Use -v to see a list of the files searched for. + Use -v (or `:set -v` in ghci) to see a list of the files searched for. diff --git a/testsuite/tests/perf/haddock/all.T b/testsuite/tests/perf/haddock/all.T index 7aed869767..393a69706e 100644 --- a/testsuite/tests/perf/haddock/all.T +++ b/testsuite/tests/perf/haddock/all.T @@ -6,10 +6,11 @@ test('haddock.base', [extra_files(['../../../../libraries/base/dist-install/haddock.t']), unless(in_tree_compiler(), skip), req_haddock ,stats_num_field('bytes allocated', - [(platform('x86_64-unknown-mingw32'), 24286343184, 5) + [(platform('x86_64-unknown-mingw32'), 18733710728, 5) # 2017-02-19 24286343184 (x64/Windows) - Generalize kind of (->) + # 2017-12-24 18733710728 (x64/Windows) - Unknown - ,(wordsize(64), 23677299848, 5) + ,(wordsize(64), 24662232152, 5) # 2012-08-14: 5920822352 (amd64/Linux) # 2012-09-20: 5829972376 (amd64/Linux) # 2012-10-08: 5902601224 (amd64/Linux) @@ -42,6 +43,15 @@ test('haddock.base', # 2017-06-05: 27868466432 (x86_64/Linux) - Desugar modules compiled with -fno-code # 2017-06-06: 25173968808 (x86_64/Linux) - Don't pass on -dcore-lint in Haddock.mk # 2017-07-12: 23677299848 (x86_64/Linux) - Use getNameToInstancesIndex + # 2017-08-22: 19694554424 (x86_64/Linux) - Various Haddock optimizations + # 2018-03-31: 20980255200 (x86_64/Linux) - Track type variable scope more carefully + # previous to this last commit, the allocations were right below the top + # of the range. This commit adds only ~1.5% allocations. + # 2018-04-10: 18511324808 (x86_64/Linux) - TTG HsBinds and Data instances + # 2018-04-11: 20727464616 (x86_64/Linux) - Collateral of simplCast improvement (#14737) + # 2018-04-20: 18971030224 (x86_64/Linux) - Cache coercion roles + # 2018-05-14: 21123660336 (amd64/Linux) - D4659: strictness to fix space leaks + # 2018-06-14: 24662232152 (amd64/Linux) - Bump haddock ,(platform('i386-unknown-mingw32'), 2885173512, 5) # 2013-02-10: 3358693084 (x86/Windows) @@ -68,7 +78,7 @@ test('haddock.Cabal', [extra_files(['../../../../libraries/Cabal/Cabal/dist-install/haddock.t']), unless(in_tree_compiler(), skip), req_haddock ,stats_num_field('bytes allocated', - [(wordsize(64), 18753963960 , 5) + [(wordsize(64), 27520214496, 5) # 2012-08-14: 3255435248 (amd64/Linux) # 2012-08-29: 3324606664 (amd64/Linux, new codegen) # 2012-10-08: 3373401360 (amd64/Linux) @@ -116,6 +126,14 @@ test('haddock.Cabal', # 2017-05-31: 18269309128 (amd64/Linux) - Faster checkFamInstConsistency # 2017-06-05: 22294859000 (amd64/Linux) - Desugar modules compiled with -fno-code # 2017-06-05: 18753963960 (amd64/Linux) - Don't pass on -dcore-lint in Haddock.mk + # 2017-08-22: 15857428040 (amd64/Linux) - Various Haddock optimizations + # 2017-11-02: 17133915848 (amd64/Linux) - Phabricator D4144 + # 2017-11-06: 18936339648 (amd64/Linux) - Unknown + # 2017-11-09: 20104611952 (amd64/Linux) - Bump Cabal + # 2018-01-22: 25261834904 (amd64/Linux) - Bump Cabal + # 2018-04-10: 23525241536 (amd64/Linux) - TTG HsBinds and Data instances + # 2018-05-14: 24519860272 (amd64/Linux) - D4659: strictness to fix space leaks + # 2018-06-14: 27520214496 (amd64/Linux) - Bump haddock ,(platform('i386-unknown-mingw32'), 3293415576, 5) # 2012-10-30: 1733638168 (x86/Windows) @@ -139,7 +157,9 @@ test('haddock.compiler', [extra_files(['../../../../compiler/stage2/haddock.t']), unless(in_tree_compiler(), skip), req_haddock ,stats_num_field('bytes allocated', - [(wordsize(64), 51592019560, 10) + [(platform('x86_64-unknown-mingw32'), 56775301896, 10), + # 2017-12-24: 56775301896 (x64/Windows) + (wordsize(64), 63038317672, 10) # 2012-08-14: 26070600504 (amd64/Linux) # 2012-08-29: 26353100288 (amd64/Linux, new CG) # 2012-09-18: 26882813032 (amd64/Linux) @@ -161,6 +181,9 @@ test('haddock.compiler', # 2017-06-05: 65378619232 (amd64/Linux) Desugar modules compiled with -fno-code # 2017-06-06: 55990521024 (amd64/Linux) Don't pass on -dcore-lint in Haddock.mk # 2017-07-12: 51592019560 (amd64/Linux) Use getNameToInstancesIndex + # 2018-04-08: 91115212032 (amd64/Linux) Trees that grow + # 2018-04-10: 58410358720 (amd64/Linux) Trees that grow (HsBinds, Data instances) + # 2018-05-14: 63038317672 (amd64/Linux) D4659: strictness to fix space leaks ,(platform('i386-unknown-mingw32'), 367546388, 10) # 2012-10-30: 13773051312 (x86/Windows) diff --git a/testsuite/tests/perf/should_run/T13623.hs b/testsuite/tests/perf/should_run/T13623.hs index 7a048b2a36..83004f32ac 100644 --- a/testsuite/tests/perf/should_run/T13623.hs +++ b/testsuite/tests/perf/should_run/T13623.hs @@ -4,6 +4,7 @@ module Main where +import Data.Int import GHC.Types @@ -16,7 +17,9 @@ foo = \i j -> sfoldl' (+) 0 $ xs i j +++ ys i j {-# Inline foo #-} -main = do { n <- foo 1 1; print n } +-- We narrow the result to 32-bits to account for the fact that this overflows +-- on 32-bit machines. +main = do { n <- foo 1 1; print (fromIntegral n :: Int32) } diff --git a/testsuite/tests/perf/should_run/T13623.stdout b/testsuite/tests/perf/should_run/T13623.stdout index ac3eff3654..c94819c4ba 100644 --- a/testsuite/tests/perf/should_run/T13623.stdout +++ b/testsuite/tests/perf/should_run/T13623.stdout @@ -1 +1 @@ -65000250000 +575740560 diff --git a/testsuite/tests/perf/should_run/T14052.hs b/testsuite/tests/perf/should_run/T14052.hs new file mode 100644 index 0000000000..bab5ad00b3 --- /dev/null +++ b/testsuite/tests/perf/should_run/T14052.hs @@ -0,0 +1,4 @@ +module T14052 where + +example :: Char +example = 'a' diff --git a/testsuite/tests/perf/should_run/T14052.script b/testsuite/tests/perf/should_run/T14052.script new file mode 100644 index 0000000000..851db08e32 --- /dev/null +++ b/testsuite/tests/perf/should_run/T14052.script @@ -0,0 +1,2501 @@ +:l T14052 +:m T14052 +example : "expr0" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr1" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr2" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr3" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr4" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr5" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr6" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr7" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr8" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr9" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr10" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr11" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr12" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr13" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr14" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr15" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr16" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr17" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr18" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr19" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr20" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr21" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr22" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr23" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr24" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr25" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr26" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr27" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr28" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr29" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr30" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr31" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr32" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr33" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr34" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr35" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr36" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr37" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr38" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr39" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr40" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr41" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr42" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr43" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr44" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr45" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr46" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr47" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr48" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr49" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr50" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr51" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr52" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr53" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr54" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr55" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr56" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr57" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr58" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr59" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr60" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr61" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr62" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr63" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr64" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr65" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr66" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr67" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr68" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr69" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr70" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr71" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr72" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr73" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr74" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr75" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr76" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr77" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr78" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr79" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr80" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr81" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr82" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr83" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr84" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr85" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr86" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr87" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr88" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr89" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr90" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr91" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr92" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr93" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr94" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr95" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr96" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr97" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr98" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr99" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr100" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr101" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr102" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr103" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr104" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr105" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr106" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr107" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr108" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr109" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr110" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr111" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr112" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr113" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr114" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr115" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr116" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr117" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr118" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr119" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr120" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr121" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr122" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr123" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr124" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr125" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr126" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr127" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr128" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr129" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr130" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr131" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr132" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr133" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr134" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr135" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr136" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr137" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr138" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr139" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr140" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr141" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr142" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr143" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr144" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr145" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr146" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr147" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr148" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr149" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr150" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr151" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr152" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr153" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr154" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr155" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr156" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr157" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr158" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr159" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr160" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr161" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr162" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr163" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr164" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr165" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr166" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr167" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr168" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr169" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr170" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr171" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr172" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr173" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr174" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr175" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr176" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr177" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr178" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr179" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr180" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr181" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr182" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr183" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr184" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr185" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr186" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr187" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr188" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr189" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr190" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr191" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr192" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr193" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr194" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr195" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr196" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr197" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr198" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr199" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr200" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr201" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr202" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr203" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr204" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr205" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr206" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr207" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr208" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr209" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr210" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr211" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr212" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr213" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr214" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr215" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr216" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr217" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr218" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr219" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr220" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr221" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr222" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr223" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr224" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr225" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr226" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr227" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr228" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr229" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr230" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr231" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr232" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr233" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr234" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr235" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr236" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr237" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr238" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr239" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr240" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr241" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr242" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr243" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr244" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr245" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr246" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr247" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr248" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr249" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr250" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr251" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr252" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr253" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr254" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr255" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr256" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr257" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr258" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr259" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr260" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr261" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr262" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr263" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr264" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr265" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr266" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr267" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr268" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr269" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr270" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr271" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr272" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr273" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr274" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr275" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr276" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr277" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr278" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr279" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr280" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr281" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr282" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr283" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr284" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr285" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr286" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr287" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr288" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr289" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr290" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr291" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr292" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr293" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr294" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr295" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr296" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr297" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr298" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr299" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr300" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr301" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr302" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr303" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr304" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr305" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr306" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr307" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr308" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr309" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr310" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr311" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr312" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr313" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr314" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr315" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr316" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr317" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr318" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr319" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr320" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr321" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr322" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr323" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr324" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr325" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr326" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr327" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr328" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr329" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr330" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr331" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr332" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr333" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr334" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr335" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr336" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr337" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr338" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr339" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr340" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr341" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr342" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr343" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr344" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr345" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr346" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr347" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr348" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr349" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr350" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr351" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr352" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr353" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr354" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr355" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr356" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr357" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr358" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr359" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr360" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr361" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr362" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr363" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr364" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr365" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr366" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr367" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr368" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr369" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr370" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr371" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr372" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr373" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr374" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr375" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr376" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr377" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr378" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr379" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr380" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr381" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr382" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr383" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr384" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr385" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr386" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr387" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr388" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr389" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr390" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr391" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr392" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr393" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr394" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr395" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr396" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr397" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr398" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr399" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr400" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr401" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr402" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr403" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr404" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr405" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr406" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr407" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr408" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr409" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr410" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr411" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr412" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr413" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr414" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr415" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr416" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr417" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr418" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr419" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr420" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr421" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr422" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr423" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr424" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr425" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr426" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr427" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr428" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr429" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr430" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr431" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr432" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr433" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr434" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr435" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr436" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr437" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr438" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr439" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr440" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr441" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr442" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr443" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr444" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr445" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr446" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr447" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr448" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr449" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr450" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr451" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr452" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr453" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr454" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr455" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr456" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr457" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr458" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr459" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr460" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr461" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr462" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr463" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr464" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr465" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr466" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr467" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr468" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr469" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr470" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr471" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr472" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr473" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr474" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr475" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr476" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr477" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr478" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr479" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr480" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr481" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr482" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr483" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr484" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr485" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr486" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr487" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr488" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr489" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr490" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr491" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr492" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr493" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr494" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr495" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr496" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr497" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr498" +let foo = it +"marker" +let it = foo +:m T14052 +example : "expr499" +let foo = it +"marker" +let it = foo diff --git a/testsuite/tests/perf/should_run/T14052.stdout b/testsuite/tests/perf/should_run/T14052.stdout new file mode 100644 index 0000000000..f0c7965515 --- /dev/null +++ b/testsuite/tests/perf/should_run/T14052.stdout @@ -0,0 +1,1000 @@ +"aexpr0" +"marker" +"aexpr1" +"marker" +"aexpr2" +"marker" +"aexpr3" +"marker" +"aexpr4" +"marker" +"aexpr5" +"marker" +"aexpr6" +"marker" +"aexpr7" +"marker" +"aexpr8" +"marker" +"aexpr9" +"marker" +"aexpr10" +"marker" +"aexpr11" +"marker" +"aexpr12" +"marker" +"aexpr13" +"marker" +"aexpr14" +"marker" +"aexpr15" +"marker" +"aexpr16" +"marker" +"aexpr17" +"marker" +"aexpr18" +"marker" +"aexpr19" +"marker" +"aexpr20" +"marker" +"aexpr21" +"marker" +"aexpr22" +"marker" +"aexpr23" +"marker" +"aexpr24" +"marker" +"aexpr25" +"marker" +"aexpr26" +"marker" +"aexpr27" +"marker" +"aexpr28" +"marker" +"aexpr29" +"marker" +"aexpr30" +"marker" +"aexpr31" +"marker" +"aexpr32" +"marker" +"aexpr33" +"marker" +"aexpr34" +"marker" +"aexpr35" +"marker" +"aexpr36" +"marker" +"aexpr37" +"marker" +"aexpr38" +"marker" +"aexpr39" +"marker" +"aexpr40" +"marker" +"aexpr41" +"marker" +"aexpr42" +"marker" +"aexpr43" +"marker" +"aexpr44" +"marker" +"aexpr45" +"marker" +"aexpr46" +"marker" +"aexpr47" +"marker" +"aexpr48" +"marker" +"aexpr49" +"marker" +"aexpr50" +"marker" +"aexpr51" +"marker" +"aexpr52" +"marker" +"aexpr53" +"marker" +"aexpr54" +"marker" +"aexpr55" +"marker" +"aexpr56" +"marker" +"aexpr57" +"marker" +"aexpr58" +"marker" +"aexpr59" +"marker" +"aexpr60" +"marker" +"aexpr61" +"marker" +"aexpr62" +"marker" +"aexpr63" +"marker" +"aexpr64" +"marker" +"aexpr65" +"marker" +"aexpr66" +"marker" +"aexpr67" +"marker" +"aexpr68" +"marker" +"aexpr69" +"marker" +"aexpr70" +"marker" +"aexpr71" +"marker" +"aexpr72" +"marker" +"aexpr73" +"marker" +"aexpr74" +"marker" +"aexpr75" +"marker" +"aexpr76" +"marker" +"aexpr77" +"marker" +"aexpr78" +"marker" +"aexpr79" +"marker" +"aexpr80" +"marker" +"aexpr81" +"marker" +"aexpr82" +"marker" +"aexpr83" +"marker" +"aexpr84" +"marker" +"aexpr85" +"marker" +"aexpr86" +"marker" +"aexpr87" +"marker" +"aexpr88" +"marker" +"aexpr89" +"marker" +"aexpr90" +"marker" +"aexpr91" +"marker" +"aexpr92" +"marker" +"aexpr93" +"marker" +"aexpr94" +"marker" +"aexpr95" +"marker" +"aexpr96" +"marker" +"aexpr97" +"marker" +"aexpr98" +"marker" +"aexpr99" +"marker" +"aexpr100" +"marker" +"aexpr101" +"marker" +"aexpr102" +"marker" +"aexpr103" +"marker" +"aexpr104" +"marker" +"aexpr105" +"marker" +"aexpr106" +"marker" +"aexpr107" +"marker" +"aexpr108" +"marker" +"aexpr109" +"marker" +"aexpr110" +"marker" +"aexpr111" +"marker" +"aexpr112" +"marker" +"aexpr113" +"marker" +"aexpr114" +"marker" +"aexpr115" +"marker" +"aexpr116" +"marker" +"aexpr117" +"marker" +"aexpr118" +"marker" +"aexpr119" +"marker" +"aexpr120" +"marker" +"aexpr121" +"marker" +"aexpr122" +"marker" +"aexpr123" +"marker" +"aexpr124" +"marker" +"aexpr125" +"marker" +"aexpr126" +"marker" +"aexpr127" +"marker" +"aexpr128" +"marker" +"aexpr129" +"marker" +"aexpr130" +"marker" +"aexpr131" +"marker" +"aexpr132" +"marker" +"aexpr133" +"marker" +"aexpr134" +"marker" +"aexpr135" +"marker" +"aexpr136" +"marker" +"aexpr137" +"marker" +"aexpr138" +"marker" +"aexpr139" +"marker" +"aexpr140" +"marker" +"aexpr141" +"marker" +"aexpr142" +"marker" +"aexpr143" +"marker" +"aexpr144" +"marker" +"aexpr145" +"marker" +"aexpr146" +"marker" +"aexpr147" +"marker" +"aexpr148" +"marker" +"aexpr149" +"marker" +"aexpr150" +"marker" +"aexpr151" +"marker" +"aexpr152" +"marker" +"aexpr153" +"marker" +"aexpr154" +"marker" +"aexpr155" +"marker" +"aexpr156" +"marker" +"aexpr157" +"marker" +"aexpr158" +"marker" +"aexpr159" +"marker" +"aexpr160" +"marker" +"aexpr161" +"marker" +"aexpr162" +"marker" +"aexpr163" +"marker" +"aexpr164" +"marker" +"aexpr165" +"marker" +"aexpr166" +"marker" +"aexpr167" +"marker" +"aexpr168" +"marker" +"aexpr169" +"marker" +"aexpr170" +"marker" +"aexpr171" +"marker" +"aexpr172" +"marker" +"aexpr173" +"marker" +"aexpr174" +"marker" +"aexpr175" +"marker" +"aexpr176" +"marker" +"aexpr177" +"marker" +"aexpr178" +"marker" +"aexpr179" +"marker" +"aexpr180" +"marker" +"aexpr181" +"marker" +"aexpr182" +"marker" +"aexpr183" +"marker" +"aexpr184" +"marker" +"aexpr185" +"marker" +"aexpr186" +"marker" +"aexpr187" +"marker" +"aexpr188" +"marker" +"aexpr189" +"marker" +"aexpr190" +"marker" +"aexpr191" +"marker" +"aexpr192" +"marker" +"aexpr193" +"marker" +"aexpr194" +"marker" +"aexpr195" +"marker" +"aexpr196" +"marker" +"aexpr197" +"marker" +"aexpr198" +"marker" +"aexpr199" +"marker" +"aexpr200" +"marker" +"aexpr201" +"marker" +"aexpr202" +"marker" +"aexpr203" +"marker" +"aexpr204" +"marker" +"aexpr205" +"marker" +"aexpr206" +"marker" +"aexpr207" +"marker" +"aexpr208" +"marker" +"aexpr209" +"marker" +"aexpr210" +"marker" +"aexpr211" +"marker" +"aexpr212" +"marker" +"aexpr213" +"marker" +"aexpr214" +"marker" +"aexpr215" +"marker" +"aexpr216" +"marker" +"aexpr217" +"marker" +"aexpr218" +"marker" +"aexpr219" +"marker" +"aexpr220" +"marker" +"aexpr221" +"marker" +"aexpr222" +"marker" +"aexpr223" +"marker" +"aexpr224" +"marker" +"aexpr225" +"marker" +"aexpr226" +"marker" +"aexpr227" +"marker" +"aexpr228" +"marker" +"aexpr229" +"marker" +"aexpr230" +"marker" +"aexpr231" +"marker" +"aexpr232" +"marker" +"aexpr233" +"marker" +"aexpr234" +"marker" +"aexpr235" +"marker" +"aexpr236" +"marker" +"aexpr237" +"marker" +"aexpr238" +"marker" +"aexpr239" +"marker" +"aexpr240" +"marker" +"aexpr241" +"marker" +"aexpr242" +"marker" +"aexpr243" +"marker" +"aexpr244" +"marker" +"aexpr245" +"marker" +"aexpr246" +"marker" +"aexpr247" +"marker" +"aexpr248" +"marker" +"aexpr249" +"marker" +"aexpr250" +"marker" +"aexpr251" +"marker" +"aexpr252" +"marker" +"aexpr253" +"marker" +"aexpr254" +"marker" +"aexpr255" +"marker" +"aexpr256" +"marker" +"aexpr257" +"marker" +"aexpr258" +"marker" +"aexpr259" +"marker" +"aexpr260" +"marker" +"aexpr261" +"marker" +"aexpr262" +"marker" +"aexpr263" +"marker" +"aexpr264" +"marker" +"aexpr265" +"marker" +"aexpr266" +"marker" +"aexpr267" +"marker" +"aexpr268" +"marker" +"aexpr269" +"marker" +"aexpr270" +"marker" +"aexpr271" +"marker" +"aexpr272" +"marker" +"aexpr273" +"marker" +"aexpr274" +"marker" +"aexpr275" +"marker" +"aexpr276" +"marker" +"aexpr277" +"marker" +"aexpr278" +"marker" +"aexpr279" +"marker" +"aexpr280" +"marker" +"aexpr281" +"marker" +"aexpr282" +"marker" +"aexpr283" +"marker" +"aexpr284" +"marker" +"aexpr285" +"marker" +"aexpr286" +"marker" +"aexpr287" +"marker" +"aexpr288" +"marker" +"aexpr289" +"marker" +"aexpr290" +"marker" +"aexpr291" +"marker" +"aexpr292" +"marker" +"aexpr293" +"marker" +"aexpr294" +"marker" +"aexpr295" +"marker" +"aexpr296" +"marker" +"aexpr297" +"marker" +"aexpr298" +"marker" +"aexpr299" +"marker" +"aexpr300" +"marker" +"aexpr301" +"marker" +"aexpr302" +"marker" +"aexpr303" +"marker" +"aexpr304" +"marker" +"aexpr305" +"marker" +"aexpr306" +"marker" +"aexpr307" +"marker" +"aexpr308" +"marker" +"aexpr309" +"marker" +"aexpr310" +"marker" +"aexpr311" +"marker" +"aexpr312" +"marker" +"aexpr313" +"marker" +"aexpr314" +"marker" +"aexpr315" +"marker" +"aexpr316" +"marker" +"aexpr317" +"marker" +"aexpr318" +"marker" +"aexpr319" +"marker" +"aexpr320" +"marker" +"aexpr321" +"marker" +"aexpr322" +"marker" +"aexpr323" +"marker" +"aexpr324" +"marker" +"aexpr325" +"marker" +"aexpr326" +"marker" +"aexpr327" +"marker" +"aexpr328" +"marker" +"aexpr329" +"marker" +"aexpr330" +"marker" +"aexpr331" +"marker" +"aexpr332" +"marker" +"aexpr333" +"marker" +"aexpr334" +"marker" +"aexpr335" +"marker" +"aexpr336" +"marker" +"aexpr337" +"marker" +"aexpr338" +"marker" +"aexpr339" +"marker" +"aexpr340" +"marker" +"aexpr341" +"marker" +"aexpr342" +"marker" +"aexpr343" +"marker" +"aexpr344" +"marker" +"aexpr345" +"marker" +"aexpr346" +"marker" +"aexpr347" +"marker" +"aexpr348" +"marker" +"aexpr349" +"marker" +"aexpr350" +"marker" +"aexpr351" +"marker" +"aexpr352" +"marker" +"aexpr353" +"marker" +"aexpr354" +"marker" +"aexpr355" +"marker" +"aexpr356" +"marker" +"aexpr357" +"marker" +"aexpr358" +"marker" +"aexpr359" +"marker" +"aexpr360" +"marker" +"aexpr361" +"marker" +"aexpr362" +"marker" +"aexpr363" +"marker" +"aexpr364" +"marker" +"aexpr365" +"marker" +"aexpr366" +"marker" +"aexpr367" +"marker" +"aexpr368" +"marker" +"aexpr369" +"marker" +"aexpr370" +"marker" +"aexpr371" +"marker" +"aexpr372" +"marker" +"aexpr373" +"marker" +"aexpr374" +"marker" +"aexpr375" +"marker" +"aexpr376" +"marker" +"aexpr377" +"marker" +"aexpr378" +"marker" +"aexpr379" +"marker" +"aexpr380" +"marker" +"aexpr381" +"marker" +"aexpr382" +"marker" +"aexpr383" +"marker" +"aexpr384" +"marker" +"aexpr385" +"marker" +"aexpr386" +"marker" +"aexpr387" +"marker" +"aexpr388" +"marker" +"aexpr389" +"marker" +"aexpr390" +"marker" +"aexpr391" +"marker" +"aexpr392" +"marker" +"aexpr393" +"marker" +"aexpr394" +"marker" +"aexpr395" +"marker" +"aexpr396" +"marker" +"aexpr397" +"marker" +"aexpr398" +"marker" +"aexpr399" +"marker" +"aexpr400" +"marker" +"aexpr401" +"marker" +"aexpr402" +"marker" +"aexpr403" +"marker" +"aexpr404" +"marker" +"aexpr405" +"marker" +"aexpr406" +"marker" +"aexpr407" +"marker" +"aexpr408" +"marker" +"aexpr409" +"marker" +"aexpr410" +"marker" +"aexpr411" +"marker" +"aexpr412" +"marker" +"aexpr413" +"marker" +"aexpr414" +"marker" +"aexpr415" +"marker" +"aexpr416" +"marker" +"aexpr417" +"marker" +"aexpr418" +"marker" +"aexpr419" +"marker" +"aexpr420" +"marker" +"aexpr421" +"marker" +"aexpr422" +"marker" +"aexpr423" +"marker" +"aexpr424" +"marker" +"aexpr425" +"marker" +"aexpr426" +"marker" +"aexpr427" +"marker" +"aexpr428" +"marker" +"aexpr429" +"marker" +"aexpr430" +"marker" +"aexpr431" +"marker" +"aexpr432" +"marker" +"aexpr433" +"marker" +"aexpr434" +"marker" +"aexpr435" +"marker" +"aexpr436" +"marker" +"aexpr437" +"marker" +"aexpr438" +"marker" +"aexpr439" +"marker" +"aexpr440" +"marker" +"aexpr441" +"marker" +"aexpr442" +"marker" +"aexpr443" +"marker" +"aexpr444" +"marker" +"aexpr445" +"marker" +"aexpr446" +"marker" +"aexpr447" +"marker" +"aexpr448" +"marker" +"aexpr449" +"marker" +"aexpr450" +"marker" +"aexpr451" +"marker" +"aexpr452" +"marker" +"aexpr453" +"marker" +"aexpr454" +"marker" +"aexpr455" +"marker" +"aexpr456" +"marker" +"aexpr457" +"marker" +"aexpr458" +"marker" +"aexpr459" +"marker" +"aexpr460" +"marker" +"aexpr461" +"marker" +"aexpr462" +"marker" +"aexpr463" +"marker" +"aexpr464" +"marker" +"aexpr465" +"marker" +"aexpr466" +"marker" +"aexpr467" +"marker" +"aexpr468" +"marker" +"aexpr469" +"marker" +"aexpr470" +"marker" +"aexpr471" +"marker" +"aexpr472" +"marker" +"aexpr473" +"marker" +"aexpr474" +"marker" +"aexpr475" +"marker" +"aexpr476" +"marker" +"aexpr477" +"marker" +"aexpr478" +"marker" +"aexpr479" +"marker" +"aexpr480" +"marker" +"aexpr481" +"marker" +"aexpr482" +"marker" +"aexpr483" +"marker" +"aexpr484" +"marker" +"aexpr485" +"marker" +"aexpr486" +"marker" +"aexpr487" +"marker" +"aexpr488" +"marker" +"aexpr489" +"marker" +"aexpr490" +"marker" +"aexpr491" +"marker" +"aexpr492" +"marker" +"aexpr493" +"marker" +"aexpr494" +"marker" +"aexpr495" +"marker" +"aexpr496" +"marker" +"aexpr497" +"marker" +"aexpr498" +"marker" +"aexpr499" +"marker" diff --git a/testsuite/tests/perf/should_run/T14936.hs b/testsuite/tests/perf/should_run/T14936.hs new file mode 100644 index 0000000000..187404cc56 --- /dev/null +++ b/testsuite/tests/perf/should_run/T14936.hs @@ -0,0 +1,29 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE FlexibleContexts #-} + +module Main where + +import Prelude +import qualified Foreign.Storable as Storable +import qualified Control.Monad.State.Strict as S +import Control.Monad.IO.Class +import Foreign.Marshal.Alloc (mallocBytes) + +newtype Foo a = Foo a + +intSize :: Int +intSize = Storable.sizeOf (undefined :: Int) + +-- This 'go' loop should allocate nothing, because it specialises +-- for the shape of the state. But in 8.4 it did (Trac #14936) + +slow :: Int -> IO () +slow i = do let go 0 = pure () + go j = do Foo (!a, !off) <- S.get + S.put (Foo (a+1, off)) + go (j - 1) + S.evalStateT (go i) (Foo ((0::Int),(intSize::Int))) + +main = do { slow (10 ^ 7); print "Done" } + diff --git a/testsuite/tests/perf/should_run/T14936.stdout b/testsuite/tests/perf/should_run/T14936.stdout new file mode 100644 index 0000000000..5a32621be4 --- /dev/null +++ b/testsuite/tests/perf/should_run/T14936.stdout @@ -0,0 +1 @@ +"Done" diff --git a/testsuite/tests/perf/should_run/T14955.hs b/testsuite/tests/perf/should_run/T14955.hs new file mode 100644 index 0000000000..d1b2206ba7 --- /dev/null +++ b/testsuite/tests/perf/should_run/T14955.hs @@ -0,0 +1,20 @@ +module Main where + +import T14955a + +--test1 :: [Bool] -> Bool +--test1 = ors + +--test2 :: [Bool] -> Bool +--test2 = dors boolDict + +--test2a :: [Bool] -> Bool +--test2a xs = dors boolDict xs + +test3 :: [Bool] -> Bool +test3 xs = pors xs + +--test4 :: [Bool] -> Bool +--test4 xs = porsProxy xs + +main = print (test3 (replicate 1000000 False)) diff --git a/testsuite/tests/perf/should_run/T14955.stdout b/testsuite/tests/perf/should_run/T14955.stdout new file mode 100644 index 0000000000..0ca95142bb --- /dev/null +++ b/testsuite/tests/perf/should_run/T14955.stdout @@ -0,0 +1 @@ +True diff --git a/testsuite/tests/perf/should_run/T14955a.hs b/testsuite/tests/perf/should_run/T14955a.hs new file mode 100644 index 0000000000..2d77d8f2d4 --- /dev/null +++ b/testsuite/tests/perf/should_run/T14955a.hs @@ -0,0 +1,72 @@ +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE AllowAmbiguousTypes #-} +module T14955a where + +import Prelude (Bool(..), (||), (&&)) + +-- Implementation 1 + +class Prop r where + or :: r -> r -> r + and :: r -> r -> r + true :: r + false :: r + +instance Prop Bool where + or = (||) + and = (&&) + true = True + false = False + +-- Implementation 2 + +data PropDict r = PropDict { + dor :: r -> r -> r + , dand :: r -> r -> r + , dtrue :: r + , dfalse :: r + } + +boolDict = PropDict { + dor = (||) + , dand = (&&) + , dtrue = True + , dfalse = False } + +-- Implementation 3 + +class PropProxy r where + propDict :: PropDict r + +instance PropProxy Bool where + propDict = boolDict + +-- Implementation 4 + +class PropProxy2 r where + propDict2 :: PropDict r + dummy :: () + +instance PropProxy2 Bool where + propDict2 = boolDict + dummy = () + + +ors :: Prop r => [r] -> r +ors [] = true +ors (o:os) = o `or` ors os +{-# INLINABLE ors #-} + +dors :: PropDict r -> [r] -> r +dors pd [] = dtrue pd +dors pd (o:os) = dor pd o (dors pd os) + +pors :: PropProxy r => [r] -> r +pors [] = dtrue propDict +pors (o:os) = dor propDict o (pors os) +{-# INLINABLE pors #-} + +porsProxy :: PropProxy2 r => [r] -> r +porsProxy [] = dtrue propDict2 +porsProxy (o:os) = dor propDict2 o (porsProxy os) +{-# INLINABLE porsProxy #-} diff --git a/testsuite/tests/perf/should_run/T15226.hs b/testsuite/tests/perf/should_run/T15226.hs new file mode 100644 index 0000000000..4c09114b89 --- /dev/null +++ b/testsuite/tests/perf/should_run/T15226.hs @@ -0,0 +1,30 @@ +-- T15226 +import Control.Exception (evaluate) + +-- Just in case Prelude.repeat changes for some reason. +import Prelude hiding (repeat) + +-- We want to be sure that the compiler *doesn't* know that +-- all the elements of the list are in WHNF, because if it +-- does, PrelRules may erase the seq#'s altogether. +repeat :: a -> [a] +repeat a = res + where res = a : res +{-# NOINLINE repeat #-} -- Belt *and* suspenders + +silly :: [Int] -> IO () +silly = foldr go (pure ()) + where + go x r = do + x' <- evaluate x + evaluate (x' + 3) -- GHC should know that x' has been evaluated, + -- so this calculation will be erased entirely. + -- Otherwise, we'll create a thunk to pass to + -- evaluate. + r + +main :: IO () +-- 10,000,000 repetitions take only a twentieth of a second, +-- but allocations go up dramatically if the result is not +-- known evaluated. +main = silly $ take 10000000 $ repeat 1 diff --git a/testsuite/tests/perf/should_run/T15226a.hs b/testsuite/tests/perf/should_run/T15226a.hs new file mode 100644 index 0000000000..6e9a1dbdbb --- /dev/null +++ b/testsuite/tests/perf/should_run/T15226a.hs @@ -0,0 +1,33 @@ +-- T15226 +import Control.Exception (evaluate) + +-- Just in case Prelude.repeat changes for some reason. +import Prelude hiding (repeat) +import Data.Coerce + +-- We want to be sure that the compiler *doesn't* know that +-- all the elements of the list are in WHNF, because if it +-- does, PrelRules may erase the seq#'s altogether. +repeat :: a -> [a] +repeat a = res + where res = a : res +{-# NOINLINE repeat #-} -- Belt *and* suspenders + +newtype Foo = Foo Int + +silly :: [Int] -> IO () +silly = foldr go (pure ()) + where + go x r = do + x' <- (coerce (evaluate :: Foo -> IO Foo) :: Int -> IO Int) x + evaluate (x' + 3) -- GHC should know that x' has been evaluated, + -- so this calculation will be erased entirely. + -- Otherwise, we'll create a thunk to pass to + -- evaluate. + r + +main :: IO () +-- 10,000,000 repetitions take only a twentieth of a second, +-- but allocations go up dramatically if the result is not +-- known evaluated. +main = silly $ take 10000000 $ repeat 1 diff --git a/testsuite/tests/perf/should_run/T15426.hs b/testsuite/tests/perf/should_run/T15426.hs new file mode 100644 index 0000000000..de88c28ce0 --- /dev/null +++ b/testsuite/tests/perf/should_run/T15426.hs @@ -0,0 +1,13 @@ +import Control.Exception (evaluate) +import Data.List + +-- The following will fuse with minimal heap usage provided +-- `findIndices` is marked `INLINABLE` instead of `INLINE`. + +unsafeFindIndex p = head . findIndices p + +main = do evaluate $ elemIndex 999999 [(1::Int)..1000000] + evaluate $ elemIndices 999999 [(1::Int)..1000000] + evaluate $ findIndex (>=999999) [(1::Int)..1000000] + evaluate $ findIndices (>=999999) [(1::Int)..1000000] + evaluate $ unsafeFindIndex (>=999999) [(1::Int)..1000000] diff --git a/testsuite/tests/perf/should_run/T15578.hs b/testsuite/tests/perf/should_run/T15578.hs new file mode 100644 index 0000000000..be056e222b --- /dev/null +++ b/testsuite/tests/perf/should_run/T15578.hs @@ -0,0 +1,80 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE Strict #-} +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE DeriveGeneric #-} + +module Main where + +import qualified Data.Set as Set +import qualified Data.Text as Text + +import Data.Set (Set) +import Data.Text (Text) +import System.IO (BufferMode (NoBuffering), hSetBuffering, stdout) +import GHC.Generics (Generic) +import Control.DeepSeq (force, NFData) +import Control.Exception (evaluate) + + +-------------------------------- +-- === Running benchmarks === -- +-------------------------------- + +iters :: Int +iters = 100000000 + +src1 :: Text +src1 = Text.replicate iters "tttt" + +data Grammar a + = Tokens !(Set a) !(a -> Bool) + | Many !(Grammar a) + | X !(Grammar a) + +instance Ord a => Semigroup (Grammar a) where + Tokens s f <> Tokens s' g = Tokens (s <> s') $ \c -> f c || g c + {-# INLINE (<>) #-} + +token :: Eq a => a -> Grammar a +token = \a -> Tokens (Set.singleton a) (a ==) +{-# INLINE token #-} + +many :: Grammar a -> Grammar a +many = Many +{-# INLINE many #-} + +data Result + = Success Text Text + | Fail + deriving (Show, Generic) + +instance NFData Result + +runTokenParser :: Grammar Char -> Text -> Result +runTokenParser = \grammar stream -> case grammar of + Tokens _ tst -> let + head = Text.head stream + in if tst head + then Success (Text.tail stream) (Text.singleton head) + else Fail + Many (Tokens _ tst) -> let + (!consumed, !rest) = Text.span tst stream + in Success rest consumed + X !grammar -> runTokenParser grammar stream + +testGrammar1 :: Grammar Char +testGrammar1 = let + s1 = token 't' + in many s1 +{-# INLINE testGrammar1 #-} + +test3 :: Text -> Result +test3 src = + runTokenParser testGrammar1 src +{-# NOINLINE test3 #-} + +main :: IO () +main = do + srcx <- evaluate $ force src1 + evaluate $ force $ test3 srcx + pure () diff --git a/testsuite/tests/perf/should_run/T4978.hs b/testsuite/tests/perf/should_run/T4978.hs index b661edc483..9324b72be0 100644 --- a/testsuite/tests/perf/should_run/T4978.hs +++ b/testsuite/tests/perf/should_run/T4978.hs @@ -4,6 +4,7 @@ import qualified Data.ByteString as S import qualified Data.ByteString.Lazy as L import Data.ByteString.Internal (inlinePerformIO) import qualified Data.ByteString.Internal as S +import Data.Semigroup import Data.Monoid import Foreign import System.IO.Unsafe @@ -12,11 +13,13 @@ newtype Builder = Builder { runBuilder :: (Buffer -> [S.ByteString]) -> Buffer -> [S.ByteString] } +instance Semigroup Builder where + (<>) = append + {-# INLINE (<>) #-} + instance Monoid Builder where mempty = empty {-# INLINE mempty #-} - mappend = append - {-# INLINE mappend #-} mconcat = foldr mappend mempty {-# INLINE mconcat #-} diff --git a/testsuite/tests/perf/should_run/T8763.hs b/testsuite/tests/perf/should_run/T8763.hs new file mode 100644 index 0000000000..90c4436ce9 --- /dev/null +++ b/testsuite/tests/perf/should_run/T8763.hs @@ -0,0 +1,41 @@ +-- | The fusion helper for @enumFromThenTo \@Int@ had multiple +-- occurences of @c@, which made the simplifier refuse to inline it. +-- The new implementation for @efdtInt{Up,Dn}FB@ only have a single +-- occurence of @c@ which the simplifier inlines unconditionally. +module Main (main) where + +import Control.Monad (when, forM_) +import GHC.ST + +nop :: Monad m => a -> m () +nop _ = return () +{-# NOINLINE nop #-} + +-- This is the baseline, using @enumFromTo@ which already had only a +-- single occurence of @c@. +f :: Int -> ST s () +f n = + do + forM_ [2..n] $ \p -> do + let isPrime = p == (p - 1) + when isPrime $ + forM_ [p + p, p + p + p .. n] $ \k -> do + nop k +{-# NOINLINE f #-} + +g :: Int -> ST s () +g n = + do + forM_ [2,3..n] $ \p -> do + -- This do block should be too big to get inlined multiple times. + -- Pad with @nop@s as necessary if this doesn't reproduce anymore. + let isPrime = p == (p - 1) + when isPrime $ + forM_ [p + p, p + p + p .. n] $ \k -> do + nop k +{-# NOINLINE g #-} + +main :: IO () +main = do + -- runST (f 40000000) `seq` return () + runST (g 40000000) `seq` return () diff --git a/testsuite/tests/perf/should_run/all.T b/testsuite/tests/perf/should_run/all.T index 9c92cd6dc8..37ce0a454f 100644 --- a/testsuite/tests/perf/should_run/all.T +++ b/testsuite/tests/perf/should_run/all.T @@ -31,6 +31,15 @@ test('T10359', compile_and_run, ['-O']) +test('T14955', + [stats_num_field('bytes allocated', + [(wordsize(64), 48050760, 5), + (wordsize(32), 351508, 5)]), + only_ways(['normal']) + ], + multimod_compile_and_run, + ['T14955', '-O']) + # fortunately the values here are mostly independent of the wordsize, # because the test allocates an unboxed array of doubles. test('T3586', @@ -108,9 +117,10 @@ test('lazy-bs-alloc', test('T876', [stats_num_field('bytes allocated', - [(platform('x86_64-unknown-mingw32'), 66928, 5), + [(platform('x86_64-unknown-mingw32'), 53472, 5), # 2015-04-03: 71904 (amd64/Windows, unknown cause) # 2016-11-27: 66928 (amd64/Windows, unknown cause) + # 2017-12-24: 53472 (amd64/Windows, unknown cause) (wordsize(64), 58128, 5), # 2013-02-14: 1263712 (x86_64/Linux) @@ -307,10 +317,11 @@ test('T7257', # expected value: 1246287228 (i386/Linux) # 2016-04-06: 989850664 (i386/Linux) no idea what happened # 2017-03-25: 869850704 (x86/Linux, 64-bit machine) probably sizeExpr fix - (wordsize(64), 1414893248, 5)]), + (wordsize(64), 1297293264, 5)]), # 2012-09-21: 1774893760 (amd64/Linux) # 2015-11-03: 1654893248 (amd64/Linux) # 2016-06-22: 1414893248 (amd64/Linux, sizeExpr fix) + # 2018-06-22: 1297293264 (amd64/Linux, atomicModifyMutVar# replacement) stats_num_field('peak_megabytes_allocated', [(wordsize(32), 217, 5), # 2012-10-08: 217 (x86/Linux) @@ -374,8 +385,9 @@ test('T7954', [(wordsize(32), 920045264, 10), # some date: 1380051408 (64-bit Windows machine) # 2014-04-04: 920045264 (64-bit Windows machine) - (wordsize(64), 1680051336, 10)]), + (wordsize(64), 1280051632, 10)]), # 2014-02-10: 1680051336 (x86_64/Linux), call arity analysis + # 2018-05-03: 1280051632 (x86_64/Linux), refactor numericEnumFrom only_ways(['normal']) ], compile_and_run, @@ -454,11 +466,12 @@ test('T9203', # 2016-04-06 84345136 (i386/Debian) not sure # 2017-03-24 77969268 (x86/Linux, 64-bit machine) probably join points - , (wordsize(64), 84620888, 5) ]), + , (wordsize(64), 98360576, 5) ]), # was 95747304 # 2019-09-10 94547280 post-AMP cleanup # 2015-10-28 95451192 emit Typeable at definition site # 2016-12-19 84620888 Join points + # 2018-07-30 98360576 it's unclear only_ways(['normal'])], compile_and_run, ['-O2']) @@ -505,6 +518,13 @@ test('T13001', compile_and_run, ['-O2']) +test('T8763', + [stats_num_field('bytes allocated', + [ (wordsize(64), 41056, 20) ]), + only_ways(['normal'])], + compile_and_run, + ['-O2']) + test('T12990', [stats_num_field('bytes allocated', [ (wordsize(64), 20040936, 5) ]), @@ -542,8 +562,61 @@ test('DeriveNullTermination', normal, compile_and_run, ['']) test('T13623', [stats_num_field('bytes allocated', - [ (wordsize(64), 50936, 5) ]), + [(platform('x86_64-unknown-mingw32'), 47232, 10), + # 2017-12-24 47232 unknown + (wordsize(64), 50936, 5)]), # 2017-05-02 50936 initial only_ways(['normal'])], compile_and_run, ['-O2']) + +test('T14052', + [compiler_stats_num_field('bytes allocated', + [ (wordsize(64), 2346183840, 15) ])], + ghci_script, + ['T14052.script']) + +test('T14936', + [stats_num_field('bytes allocated', + [(platform('x86_64-unknown-mingw32'), 47536, 10), + # 2018-05-04 47536 unknown + (wordsize(64), 51792, 5) ])], + compile_and_run, + ['-O2']) + +test('T15226', + [stats_num_field('bytes allocated', + [ (wordsize(64), 41040, 5) ]), + # 2018-06-06 41040 Let the simplifier know the result + # of seq# is in WHNF + # initial 400041040 + only_ways(['normal'])], + compile_and_run, + ['-O']) + +test('T15226a', + [stats_num_field('bytes allocated', + [ (wordsize(64), 41040, 5) ]), + # 2018-06-06 41040 Look through casts for seq# + # initial 400041040 + only_ways(['normal'])], + compile_and_run, + ['-O']) + +test('T15426', + [stats_num_field('bytes allocated', + [ (wordsize(64), 41272, 20) ]), + # 2018-08-10 41272 Change findIndices from INLINE to INLINABLE + # initial 160041176 + only_ways(['normal'])], + compile_and_run, + ['-O2']) + +test('T15578', + [stats_num_field('bytes allocated', + [ (wordsize(64), 800041456, 5) ]), + # 2018-09-07 800041456 Improvements from #15578 + # initial 42400041456 + only_ways(['normal'])], + compile_and_run, + ['-O2']) diff --git a/testsuite/tests/plugins/Makefile b/testsuite/tests/plugins/Makefile index efe17efeb8..8a6af5b118 100644 --- a/testsuite/tests/plugins/Makefile +++ b/testsuite/tests/plugins/Makefile @@ -16,6 +16,39 @@ plugins07: "$(TEST_HC)" $(TEST_HC_OPTS) $(ghcPluginWayFlags) --make -v0 -O plugins07.hs -package-db rule-defining-plugin/pkg.plugins07/local.package.conf -hide-all-packages -package base -plugin-package rule-defining-plugin -fplugin=RuleDefiningPlugin ./plugins07 +.PHONY: plugins08 +plugins08: + "$(TEST_HC)" $(TEST_HC_OPTS) $(ghcPluginWayFlags) --make -v0 plugins08.hs -package-db simple-plugin/pkg.plugins08/local.package.conf + ./plugins08 + +.PHONY: plugins09 +plugins09: + "$(TEST_HC)" $(TEST_HC_OPTS) $(ghcPluginWayFlags) --make -v0 plugins09.hs -package-db simple-plugin/pkg.plugins09/local.package.conf -fplugin Simple.SourcePlugin -fplugin-opt Simple.SourcePlugin:a -fplugin-opt Simple.SourcePlugin:b -plugin-package simple-plugin + +.PHONY: plugins10 +plugins10: + "$(TEST_HC)" $(TEST_HC_OPTS) $(ghcPluginWayFlags) --make -v0 plugins10.hs QuasiQuotation.hs -package-db simple-plugin/pkg.plugins10/local.package.conf -fplugin Simple.SourcePlugin -plugin-package simple-plugin + +.PHONY: plugins11 +plugins11: + "$(TEST_HC)" $(TEST_HC_OPTS) $(ghcPluginWayFlags) --make -v0 plugins11.hs -package-db simple-plugin/pkg.plugins11/local.package.conf -plugin-package simple-plugin + +.PHONY: plugins12 +plugins12: + "$(TEST_HC)" $(TEST_HC_OPTS) $(ghcPluginWayFlags) --make -v0 plugins12.hs -package-db simple-plugin/pkg.plugins12/local.package.conf -plugin-package simple-plugin + +.PHONY: plugins13 +plugins13: + "$(TEST_HC)" $(TEST_HC_OPTS) $(ghcPluginWayFlags) --make -v0 plugins13.hs PluginFilteredExport.hs -package-db simple-plugin/pkg.plugins13/local.package.conf -plugin-package simple-plugin + +.PHONY: plugins14 +plugins14: + "$(TEST_HC)" $(TEST_HC_OPTS) $(ghcPluginWayFlags) --make -v0 plugins14.hs -package-db simple-plugin/pkg.plugins14/local.package.conf -plugin-package simple-plugin + +.PHONY: plugins15 +plugins15: + "$(TEST_HC)" $(TEST_HC_OPTS) $(ghcPluginWayFlags) --make -v0 plugins15.hs MetaRemoveHelper.hs -package-db simple-plugin/pkg.plugins15/local.package.conf -plugin-package simple-plugin + # -package (should work for backwards compatibility) .PHONY: T10420 T10420: @@ -45,5 +78,46 @@ T11244: .PHONY: T12567a T12567a: "$(TEST_HC)" $(TEST_HC_OPTS) $(ghcPluginWayFlags) --make T12567a.hs -package-db simple-plugin/pkg.T12567a/local.package.conf -hide-all-plugin-packages -plugin-package simple-plugin 1>&2 - "$(TEST_HC)" $(TEST_HC_OPTS) $(ghcPluginWayFlags) --make T12567a.hs -package-db simple-plugin/pkg.T12567a/local.package.conf -hide-all-plugin-packages -plugin-package simple-plugin 2>&1 | grep "T12567a.hs, T12567a.o" 1>&2 + "$(TEST_HC)" $(TEST_HC_OPTS) $(ghcPluginWayFlags) --make T12567a.hs -package-db simple-plugin/pkg.T12567a/local.package.conf -hide-all-plugin-packages -plugin-package simple-plugin 1>&2 "$(TEST_HC)" $(TEST_HC_OPTS) $(ghcPluginWayFlags) --make T12567b.hs -package-db simple-plugin/pkg.T12567a/local.package.conf -hide-all-plugin-packages -plugin-package simple-plugin 1>&2 + +.PHONY: T14335 +T14335: + "$(TEST_HC)" $(TEST_HC_OPTS) $(ghcPluginWayFlags) -fexternal-interpreter --make -v0 plugins01.hs -package-db simple-plugin/pkg.plugins01/local.package.conf -fplugin Simple.Plugin -fplugin-opt Simple.Plugin:Irrelevant_Option -hide-all-plugin-packages -plugin-package simple-plugin + ./plugins01 + +# Shouldn't recompile the module +.PHONY: plugin-recomp-pure +plugin-recomp-pure: + "$(TEST_HC)" $(TEST_HC_OPTS) $(ghcPluginWayFlags) plugin-recomp-test.hs -package-db plugin-recomp/pkg.plugins01/local.package.conf -fplugin PurePlugin + "$(TEST_HC)" $(TEST_HC_OPTS) $(ghcPluginWayFlags) plugin-recomp-test.hs -package-db plugin-recomp/pkg.plugins01/local.package.conf -fplugin PurePlugin + +# Should recompile the module +.PHONY: plugin-recomp-impure +plugin-recomp-impure: + "$(TEST_HC)" $(TEST_HC_OPTS) $(ghcPluginWayFlags) plugin-recomp-test.hs -package-db plugin-recomp/pkg.plugins01/local.package.conf -fplugin ImpurePlugin + "$(TEST_HC)" $(TEST_HC_OPTS) $(ghcPluginWayFlags) plugin-recomp-test.hs -package-db plugin-recomp/pkg.plugins01/local.package.conf -fplugin ImpurePlugin + +# Should not recompile the module the first time but should the second time +.PHONY: plugin-recomp-flags +plugin-recomp-flags: + "$(TEST_HC)" $(TEST_HC_OPTS) $(ghcPluginWayFlags) plugin-recomp-test.hs -package-db plugin-recomp/pkg.plugins01/local.package.conf -fplugin FingerprintPlugin -fplugin-opt FingerprintPlugin:0 + "$(TEST_HC)" $(TEST_HC_OPTS) $(ghcPluginWayFlags) plugin-recomp-test.hs -package-db plugin-recomp/pkg.plugins01/local.package.conf -fplugin FingerprintPlugin -fplugin-opt FingerprintPlugin:0 + "$(TEST_HC)" $(TEST_HC_OPTS) $(ghcPluginWayFlags) plugin-recomp-test.hs -package-db plugin-recomp/pkg.plugins01/local.package.conf -fplugin FingerprintPlugin -fplugin-opt FingerprintPlugin:1 + "$(TEST_HC)" $(TEST_HC_OPTS) $(ghcPluginWayFlags) plugin-recomp-test.hs -package-db plugin-recomp/pkg.plugins01/local.package.conf -fplugin FingerprintPlugin -fplugin-opt FingerprintPlugin:1 + +# Should recompile the module because the plugin changed +.PHONY: plugin-recomp-change +plugin-recomp-change: + "$(TEST_HC)" $(TEST_HC_OPTS) $(ghcPluginWayFlags) -v0 plugin-recomp-test.hs -package-db plugin-recomp/pkg.plugins01/local.package.conf -fplugin PurePlugin + "$(MAKE)" -s --no-print-directory -C plugin-recomp package.plugins01 TOP=$(TOP) RUN=-DRUN2 + "$(TEST_HC)" $(TEST_HC_OPTS) $(ghcPluginWayFlags) -v0 plugin-recomp-test.hs -package-db plugin-recomp/pkg.plugins01/local.package.conf -fplugin PurePlugin + +# Should recompile the module because the plugin changed, test for 15492 +.PHONY: plugin-recomp-change-prof +plugin-recomp-change-prof: + "$(TEST_HC)" $(TEST_HC_OPTS) $(ghcPluginWayFlags) -v0 plugin-recomp-test.hs -package-db plugin-recomp/pkg.plugins01/local.package.conf -fplugin PurePlugin + "$(TEST_HC)" $(TEST_HC_OPTS) -prof -osuf p_o -hisuf p_hi -v0 plugin-recomp-test.hs -package-db plugin-recomp/pkg.plugins01/local.package.conf -fplugin PurePlugin + "$(MAKE)" -s --no-print-directory -C plugin-recomp package.plugins01 TOP=$(TOP) RUN=-DRUN2 + "$(TEST_HC)" $(TEST_HC_OPTS) $(ghcPluginWayFlags) -v0 plugin-recomp-test.hs -package-db plugin-recomp/pkg.plugins01/local.package.conf -fplugin PurePlugin + "$(TEST_HC)" $(TEST_HC_OPTS) -prof -osuf p_o -hisuf p_hi -v0 plugin-recomp-test.hs -package-db plugin-recomp/pkg.plugins01/local.package.conf -fplugin PurePlugin diff --git a/testsuite/tests/plugins/MetaRemoveHelper.hs b/testsuite/tests/plugins/MetaRemoveHelper.hs new file mode 100644 index 0000000000..06a67995f7 --- /dev/null +++ b/testsuite/tests/plugins/MetaRemoveHelper.hs @@ -0,0 +1,6 @@ +module MetaRemoveHelper where + +import Language.Haskell.TH + +clear :: Q [Dec] -> Q [Dec] +clear _ = return [] diff --git a/testsuite/tests/plugins/PluginFilteredExport.hs b/testsuite/tests/plugins/PluginFilteredExport.hs new file mode 100644 index 0000000000..6dd62d33ff --- /dev/null +++ b/testsuite/tests/plugins/PluginFilteredExport.hs @@ -0,0 +1,8 @@ +{-# OPTIONS_GHC -fplugin Simple.RemovePlugin #-} +{-# OPTIONS_GHC -fplugin-opt Simple.RemovePlugin:map #-} +{-# OPTIONS_GHC -fplugin-opt Simple.RemovePlugin:typecheck #-} +-- testing that the plugin can alter the parsed representation +module PluginFilteredExport where + +map :: () +map = () diff --git a/testsuite/tests/plugins/QuasiQuotation.hs b/testsuite/tests/plugins/QuasiQuotation.hs new file mode 100644 index 0000000000..b8fe5d6b26 --- /dev/null +++ b/testsuite/tests/plugins/QuasiQuotation.hs @@ -0,0 +1,11 @@ +module QuasiQuotation where + +import Language.Haskell.TH +import Language.Haskell.TH.Quote + +stringify :: QuasiQuoter +stringify = QuasiQuoter { quoteExp = return . LitE . StringL + , quotePat = return . LitP . StringL + , quoteType = return . LitT . StrTyLit + , quoteDec = const (return []) + } diff --git a/testsuite/tests/plugins/T11244.stderr b/testsuite/tests/plugins/T11244.stderr index f489103f28..72f01060db 100644 --- a/testsuite/tests/plugins/T11244.stderr +++ b/testsuite/tests/plugins/T11244.stderr @@ -1,4 +1,5 @@ -<command line>: Could not find module ‘RuleDefiningPlugin’ -Perhaps you meant - RuleDefiningPlugin (from rule-defining-plugin-0.1) -Use -v to see a list of the files searched for. +<command line>: Could not load module ‘RuleDefiningPlugin’ +It is a member of the hidden package ‘rule-defining-plugin-0.1’. +You can run ‘:set -package rule-defining-plugin’ to expose it. +(Note: this unloads all the modules in the current scope.) +Use -v (or `:set -v` in ghci) to see a list of the files searched for. diff --git a/testsuite/tests/plugins/T12567a.stderr b/testsuite/tests/plugins/T12567a.stderr index aee35e3528..efc75384e6 100644 --- a/testsuite/tests/plugins/T12567a.stderr +++ b/testsuite/tests/plugins/T12567a.stderr @@ -2,9 +2,4 @@ Simple Plugin Passes Queried Got options: Simple Plugin Pass Run -[1 of 1] Compiling T12567a ( T12567a.hs, T12567a.o ) [Simple.Plugin changed] -[1 of 2] Compiling T12567a ( T12567a.hs, T12567a.o ) [Simple.Plugin changed] -Simple Plugin Passes Queried -Got options: -Simple Plugin Pass Run [2 of 2] Compiling T12567b ( T12567b.hs, T12567b.o ) diff --git a/testsuite/tests/plugins/T14335.hs b/testsuite/tests/plugins/T14335.hs new file mode 100644 index 0000000000..49a0085247 --- /dev/null +++ b/testsuite/tests/plugins/T14335.hs @@ -0,0 +1 @@ +module T14335 where diff --git a/testsuite/tests/plugins/T14335.stderr b/testsuite/tests/plugins/T14335.stderr new file mode 100644 index 0000000000..1f051a79b4 --- /dev/null +++ b/testsuite/tests/plugins/T14335.stderr @@ -0,0 +1 @@ +<command line>: Plugins require -fno-external-interpreter diff --git a/testsuite/tests/plugins/all.T b/testsuite/tests/plugins/all.T index 9e17eb42c8..339b9bab76 100644 --- a/testsuite/tests/plugins/all.T +++ b/testsuite/tests/plugins/all.T @@ -1,55 +1,118 @@ setTestOpts(req_interp) +# The implementation of ghc-pkg doesn't seem to be multi-concurrent process safe +# on windows. These tests which mutate the package db need to be run +# sequentially until this is fixed. This likely means that #13194 isn't fully +# solved. See also #15313. + test('plugins01', - [extra_files(['simple-plugin/']), + [extra_files(['simple-plugin/']), when(opsys('mingw32'), multi_cpu_race), pre_cmd('$MAKE -s --no-print-directory -C simple-plugin package.plugins01 TOP={top}')], run_command, ['$MAKE -s --no-print-directory plugins01']) test('plugins02', - [extra_files(['simple-plugin/']), + [extra_files(['simple-plugin/']), when(opsys('mingw32'), multi_cpu_race), pre_cmd('$MAKE -s --no-print-directory -C simple-plugin package.plugins02 TOP={top}')], compile_fail, ['-package-db simple-plugin/pkg.plugins02/local.package.conf -fplugin Simple.BadlyTypedPlugin -package simple-plugin ' + config.plugin_way_flags]) test('plugins03', - [extra_files(['simple-plugin/']), + [extra_files(['simple-plugin/']), when(opsys('mingw32'), multi_cpu_race), pre_cmd('$MAKE -s --no-print-directory -C simple-plugin package.plugins03 TOP={top}')], compile_fail, ['-package-db simple-plugin/pkg.plugins03/local.package.conf -fplugin Simple.NonExistentPlugin -package simple-plugin']) -test('plugins04', [extra_files(['HomePackagePlugin.hs'])], multimod_compile_fail, +test('plugins04', [extra_files(['HomePackagePlugin.hs']), + when(opsys('mingw32'), multi_cpu_race)], + multimod_compile_fail, ['plugins04', '-package ghc -fplugin HomePackagePlugin']) test('plugins05', [extra_files(['HomePackagePlugin.hs']), + when(opsys('mingw32'), multi_cpu_race), only_ways([config.ghc_plugin_way])], multimod_compile_and_run, ['plugins05', '-package ghc']) test('plugins06', [extra_files(['LinkerTicklingPlugin.hs']), + when(opsys('mingw32'), multi_cpu_race), unless(have_dynamic(), skip), only_ways([config.ghc_plugin_way])], multimod_compile_and_run, ['plugins06', '-package ghc']) test('plugins07', [extra_files(['rule-defining-plugin/']), + when(opsys('mingw32'), multi_cpu_race), pre_cmd('$MAKE -s --no-print-directory -C rule-defining-plugin package.plugins07 TOP={top}')], run_command, ['$MAKE -s --no-print-directory plugins07']) +test('plugins08', + [extra_files(['simple-plugin/']), + when(opsys('mingw32'), multi_cpu_race), + pre_cmd('$MAKE -s --no-print-directory -C simple-plugin package.plugins08 TOP={top}')], + run_command, ['$MAKE -s --no-print-directory plugins08']) + +test('plugins09', + [extra_files(['simple-plugin/']), + when(opsys('mingw32'), multi_cpu_race), + pre_cmd('$MAKE -s --no-print-directory -C simple-plugin package.plugins09 TOP={top}')], + run_command, ['$MAKE -s --no-print-directory plugins09']) + +test('plugins10', + [expect_broken(15216), + extra_files(['simple-plugin/', 'QuasiQuotation.hs']), + when(opsys('mingw32'), multi_cpu_race), + pre_cmd('$MAKE -s --no-print-directory -C simple-plugin package.plugins10 TOP={top}')], + run_command, ['$MAKE -s --no-print-directory plugins10']) + +test('plugins11', + [extra_files(['simple-plugin/']), + when(opsys('mingw32'), multi_cpu_race), + pre_cmd('$MAKE -s --no-print-directory -C simple-plugin package.plugins11 TOP={top}')], + run_command, ['$MAKE -s --no-print-directory plugins11']) + +test('plugins12', + [extra_files(['simple-plugin/']), + when(opsys('mingw32'), multi_cpu_race), + pre_cmd('$MAKE -s --no-print-directory -C simple-plugin package.plugins12 TOP={top}')], + run_command, ['$MAKE -s --no-print-directory plugins12']) + +test('plugins13', + [extra_files(['simple-plugin/', 'PluginFilteredExport.hs']), + when(opsys('mingw32'), multi_cpu_race), + pre_cmd('$MAKE -s --no-print-directory -C simple-plugin package.plugins13 TOP={top}')], + run_command, ['$MAKE -s --no-print-directory plugins13']) + +test('plugins14', + [extra_files(['simple-plugin/']), + when(opsys('mingw32'), multi_cpu_race), + pre_cmd('$MAKE -s --no-print-directory -C simple-plugin package.plugins14 TOP={top}')], + run_command, ['$MAKE -s --no-print-directory plugins14']) + +test('plugins15', + [extra_files(['simple-plugin/', 'MetaRemoveHelper.hs']), + when(opsys('mingw32'), multi_cpu_race), + pre_cmd('$MAKE -s --no-print-directory -C simple-plugin package.plugins15 TOP={top}')], + run_command, ['$MAKE -s --no-print-directory plugins15']) + test('T10420', [extra_files(['rule-defining-plugin/']), + when(opsys('mingw32'), multi_cpu_race), pre_cmd('$MAKE -s --no-print-directory -C rule-defining-plugin package.T10420 TOP={top}')], run_command, ['$MAKE -s --no-print-directory T10420']) test('T10294', [extra_files(['annotation-plugin/']), + when(opsys('mingw32'), multi_cpu_race), pre_cmd('$MAKE -s --no-print-directory -C annotation-plugin package.T10294 TOP={top}')], run_command, ['$MAKE -s --no-print-directory T10294']) test('T10294a', [extra_files(['annotation-plugin/']), + when(opsys('mingw32'), multi_cpu_race), pre_cmd('$MAKE -s --no-print-directory -C annotation-plugin package.T10294a TOP={top}')], run_command, ['$MAKE -s --no-print-directory T10294a']) test('frontend01', [extra_files(['FrontendPlugin.hs']), + when(opsys('mingw32'), multi_cpu_race), unless(have_dynamic(), expect_broken(10301))], run_command, ['$MAKE -s --no-print-directory frontend01']) @@ -60,5 +123,48 @@ test('T11244', test('T12567a', [extra_files(['T12567b.hs', 'simple-plugin/']), + when(opsys('mingw32'), multi_cpu_race), pre_cmd('$MAKE -s --no-print-directory -C simple-plugin package.T12567a TOP={top}')], run_command, ['$MAKE -s --no-print-directory T12567a']) + +test('T14335', + [extra_files(['simple-plugin/', 'plugins01.hs']), + when(opsys('mingw32'), multi_cpu_race), + pre_cmd('$MAKE -s --no-print-directory -C simple-plugin package.plugins01 TOP={top}')], + compile_fail, + ['-package-db simple-plugin/pkg.plugins01/local.package.conf -fplugin Simple.Plugin \ + -fexternal-interpreter -package simple-plugin ' + config.plugin_way_flags]) + +test('plugin-recomp-pure', + [extra_files(['plugin-recomp/', 'plugin-recomp-test.hs']), + when(opsys('mingw32'), multi_cpu_race), + pre_cmd('$MAKE -s --no-print-directory -C plugin-recomp package.plugins01 TOP={top}') + ], + run_command, ['$MAKE -s --no-print-directory plugin-recomp-pure']) + +test('plugin-recomp-impure', + [extra_files(['plugin-recomp/', 'plugin-recomp-test.hs']), + when(opsys('mingw32'), multi_cpu_race), + pre_cmd('$MAKE -s --no-print-directory -C plugin-recomp package.plugins01 TOP={top}') + ], + run_command, ['$MAKE -s --no-print-directory plugin-recomp-impure']) + +test('plugin-recomp-flags', + [extra_files(['plugin-recomp/', 'plugin-recomp-test.hs']), + when(opsys('mingw32'), multi_cpu_race), + pre_cmd('$MAKE -s --no-print-directory -C plugin-recomp package.plugins01 TOP={top}') + ], + run_command, ['$MAKE -s --no-print-directory plugin-recomp-flags']) + +test('plugin-recomp-change', + [extra_files(['plugin-recomp/', 'plugin-recomp-test.hs']), + pre_cmd('$MAKE -s --no-print-directory -C plugin-recomp package.plugins01 TOP={top}') + ], + run_command, ['$MAKE -s --no-print-directory plugin-recomp-change']) + +test('plugin-recomp-change-prof', + [extra_files(['plugin-recomp/', 'plugin-recomp-test.hs']), + pre_cmd('$MAKE -s --no-print-directory -C plugin-recomp package.plugins01 TOP={top}'), + when(not config.have_profiling,skip) + ], + run_command, ['$MAKE -s --no-print-directory plugin-recomp-change-prof']) diff --git a/testsuite/tests/plugins/plugin-recomp-change-prof.stderr b/testsuite/tests/plugins/plugin-recomp-change-prof.stderr new file mode 100644 index 0000000000..b8018055db --- /dev/null +++ b/testsuite/tests/plugins/plugin-recomp-change-prof.stderr @@ -0,0 +1,12 @@ +Simple Plugin Passes Queried +Got options: +Simple Plugin Pass Run +Simple Plugin Passes Queried +Got options: +Simple Plugin Pass Run +Simple Plugin Passes Queried +Got options: +Simple Plugin Pass Run 2 +Simple Plugin Passes Queried +Got options: +Simple Plugin Pass Run 2 diff --git a/testsuite/tests/plugins/plugin-recomp-change.stderr b/testsuite/tests/plugins/plugin-recomp-change.stderr new file mode 100644 index 0000000000..91747c8b7d --- /dev/null +++ b/testsuite/tests/plugins/plugin-recomp-change.stderr @@ -0,0 +1,6 @@ +Simple Plugin Passes Queried +Got options: +Simple Plugin Pass Run +Simple Plugin Passes Queried +Got options: +Simple Plugin Pass Run 2 diff --git a/testsuite/tests/plugins/plugin-recomp-flags.stderr b/testsuite/tests/plugins/plugin-recomp-flags.stderr new file mode 100644 index 0000000000..a7f0da692a --- /dev/null +++ b/testsuite/tests/plugins/plugin-recomp-flags.stderr @@ -0,0 +1,6 @@ +Simple Plugin Passes Queried +Got options: 0 +Simple Plugin Pass Run +Simple Plugin Passes Queried +Got options: 1 +Simple Plugin Pass Run diff --git a/testsuite/tests/plugins/plugin-recomp-flags.stdout b/testsuite/tests/plugins/plugin-recomp-flags.stdout new file mode 100644 index 0000000000..342fa3e0f8 --- /dev/null +++ b/testsuite/tests/plugins/plugin-recomp-flags.stdout @@ -0,0 +1,4 @@ +[1 of 1] Compiling Main ( plugin-recomp-test.hs, plugin-recomp-test.o ) +Linking plugin-recomp-test ... +[1 of 1] Compiling Main ( plugin-recomp-test.hs, plugin-recomp-test.o ) [Plugin fingerprint changed] +Linking plugin-recomp-test ... diff --git a/testsuite/tests/plugins/plugin-recomp-impure.stderr b/testsuite/tests/plugins/plugin-recomp-impure.stderr new file mode 100644 index 0000000000..a1edc3bda5 --- /dev/null +++ b/testsuite/tests/plugins/plugin-recomp-impure.stderr @@ -0,0 +1,6 @@ +Simple Plugin Passes Queried +Got options: +Simple Plugin Pass Run +Simple Plugin Passes Queried +Got options: +Simple Plugin Pass Run diff --git a/testsuite/tests/plugins/plugin-recomp-impure.stdout b/testsuite/tests/plugins/plugin-recomp-impure.stdout new file mode 100644 index 0000000000..d282cfea8f --- /dev/null +++ b/testsuite/tests/plugins/plugin-recomp-impure.stdout @@ -0,0 +1,4 @@ +[1 of 1] Compiling Main ( plugin-recomp-test.hs, plugin-recomp-test.o ) +Linking plugin-recomp-test ... +[1 of 1] Compiling Main ( plugin-recomp-test.hs, plugin-recomp-test.o ) [Plugin forced recompilation] +Linking plugin-recomp-test ... diff --git a/testsuite/tests/plugins/plugin-recomp-pure.stderr b/testsuite/tests/plugins/plugin-recomp-pure.stderr new file mode 100644 index 0000000000..84e15cfa91 --- /dev/null +++ b/testsuite/tests/plugins/plugin-recomp-pure.stderr @@ -0,0 +1,3 @@ +Simple Plugin Passes Queried +Got options: +Simple Plugin Pass Run diff --git a/testsuite/tests/plugins/plugin-recomp-pure.stdout b/testsuite/tests/plugins/plugin-recomp-pure.stdout new file mode 100644 index 0000000000..a6828318a0 --- /dev/null +++ b/testsuite/tests/plugins/plugin-recomp-pure.stdout @@ -0,0 +1,2 @@ +[1 of 1] Compiling Main ( plugin-recomp-test.hs, plugin-recomp-test.o ) +Linking plugin-recomp-test ... diff --git a/testsuite/tests/plugins/plugin-recomp-test.hs b/testsuite/tests/plugins/plugin-recomp-test.hs new file mode 100644 index 0000000000..2cc84a9eac --- /dev/null +++ b/testsuite/tests/plugins/plugin-recomp-test.hs @@ -0,0 +1,8 @@ +-- Intended to test that the plugins have basic functionality -- +-- * Can modify the program +-- * Get to see command line options +module Main where + +main = do + putStrLn "Program Started" + putStrLn "Program Ended" diff --git a/testsuite/tests/plugins/plugin-recomp/Common.hs b/testsuite/tests/plugins/plugin-recomp/Common.hs new file mode 100644 index 0000000000..ce4f8240c8 --- /dev/null +++ b/testsuite/tests/plugins/plugin-recomp/Common.hs @@ -0,0 +1,22 @@ +{-# LANGUAGE CPP #-} +module Common where + +import GhcPlugins + +install :: [CommandLineOption] -> [CoreToDo] -> CoreM [CoreToDo] +install options todos = do + putMsgS $ "Simple Plugin Passes Queried" + putMsgS $ "Got options: " ++ unwords options + + -- Create some actual passes to continue the test. + return $ CoreDoPluginPass "Main pass" mainPass + : todos + +mainPass :: ModGuts -> CoreM ModGuts +mainPass guts = do +#if defined(RUN2) + putMsgS "Simple Plugin Pass Run 2" +#else + putMsgS "Simple Plugin Pass Run" +#endif + return guts diff --git a/testsuite/tests/plugins/plugin-recomp/FingerprintPlugin.hs b/testsuite/tests/plugins/plugin-recomp/FingerprintPlugin.hs new file mode 100644 index 0000000000..584962470a --- /dev/null +++ b/testsuite/tests/plugins/plugin-recomp/FingerprintPlugin.hs @@ -0,0 +1,10 @@ +module FingerprintPlugin where + +import GhcPlugins +import Common + +plugin :: Plugin +plugin = defaultPlugin { + installCoreToDos = install, + pluginRecompile = flagRecompile + } diff --git a/testsuite/tests/plugins/plugin-recomp/ImpurePlugin.hs b/testsuite/tests/plugins/plugin-recomp/ImpurePlugin.hs new file mode 100644 index 0000000000..0ccb626a15 --- /dev/null +++ b/testsuite/tests/plugins/plugin-recomp/ImpurePlugin.hs @@ -0,0 +1,10 @@ +module ImpurePlugin where + +import GhcPlugins +import Common + +plugin :: Plugin +plugin = defaultPlugin { + installCoreToDos = install, + pluginRecompile = impurePlugin + } diff --git a/testsuite/tests/plugins/plugin-recomp/LICENSE b/testsuite/tests/plugins/plugin-recomp/LICENSE new file mode 100644 index 0000000000..6297f71b3f --- /dev/null +++ b/testsuite/tests/plugins/plugin-recomp/LICENSE @@ -0,0 +1,10 @@ +Copyright (c) 2008, Max Bolingbroke +All rights reserved. + +Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. + * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. + * Neither the name of Max Bolingbroke nor the names of other contributors may be used to endorse or promote products derived from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/testsuite/tests/plugins/plugin-recomp/Makefile b/testsuite/tests/plugins/plugin-recomp/Makefile new file mode 100644 index 0000000000..9ee7737339 --- /dev/null +++ b/testsuite/tests/plugins/plugin-recomp/Makefile @@ -0,0 +1,23 @@ +TOP=../../.. +RUN=-DRUN1 +include $(TOP)/mk/boilerplate.mk +include $(TOP)/mk/test.mk + +clean.%: + rm -rf pkg.$* + +HERE := $(abspath .) +$(eval $(call canonicalise,HERE)) + +package.%: + $(MAKE) -s --no-print-directory clean.$* + mkdir pkg.$* + "$(TEST_HC)" -outputdir pkg.$* --make -v0 -o pkg.$*/setup Setup.hs + + "$(GHC_PKG)" init pkg.$*/local.package.conf + + # The bogus extra-lib-dirs ensures the package is registered with multiple + # dynamic-library-directories which tests that the fix for #15475 works + pkg.$*/setup configure --distdir pkg.$*/dist -v0 $(CABAL_PLUGIN_BUILD) --ghc-option="$(RUN)" --prefix="$(HERE)/pkg.$*/install" --with-compiler="$(TEST_HC)" --with-hc-pkg="$(GHC_PKG)" --extra-lib-dirs="$(HERE)" --package-db=pkg.$*/local.package.conf $(if $(findstring YES,$(HAVE_PROFILING)), --enable-library-profiling) + pkg.$*/setup build --distdir pkg.$*/dist -v0 + pkg.$*/setup install --distdir pkg.$*/dist -v0 diff --git a/testsuite/tests/plugins/plugin-recomp/PurePlugin.hs b/testsuite/tests/plugins/plugin-recomp/PurePlugin.hs new file mode 100644 index 0000000000..c106aa3400 --- /dev/null +++ b/testsuite/tests/plugins/plugin-recomp/PurePlugin.hs @@ -0,0 +1,10 @@ +module PurePlugin where + +import GhcPlugins +import Common + +plugin :: Plugin +plugin = defaultPlugin { + installCoreToDos = install, + pluginRecompile = purePlugin + } diff --git a/testsuite/tests/plugins/plugin-recomp/Setup.hs b/testsuite/tests/plugins/plugin-recomp/Setup.hs new file mode 100644 index 0000000000..e8ef27dbba --- /dev/null +++ b/testsuite/tests/plugins/plugin-recomp/Setup.hs @@ -0,0 +1,3 @@ +import Distribution.Simple + +main = defaultMain diff --git a/testsuite/tests/plugins/plugin-recomp/plugin-recomp.cabal b/testsuite/tests/plugins/plugin-recomp/plugin-recomp.cabal new file mode 100644 index 0000000000..dabaf72e03 --- /dev/null +++ b/testsuite/tests/plugins/plugin-recomp/plugin-recomp.cabal @@ -0,0 +1,20 @@ +Name: plugin-recompilation +Version: 0.1 +Synopsis: Testing plugin recompilation +Cabal-Version: >= 1.2 +Build-Type: Simple +License: BSD3 +License-File: LICENSE +Author: Matthew Pickering +Homepage: http://blog.omega-prime.co.uk + +Library + Extensions: CPP + Build-Depends: + base, + ghc >= 6.11 + Exposed-Modules: + PurePlugin + ImpurePlugin + FingerprintPlugin + Common diff --git a/testsuite/tests/plugins/plugins03.stderr b/testsuite/tests/plugins/plugins03.stderr index c02965ad1f..a923550592 100644 --- a/testsuite/tests/plugins/plugins03.stderr +++ b/testsuite/tests/plugins/plugins03.stderr @@ -1,2 +1,2 @@ <command line>: Could not find module ‘Simple.NonExistentPlugin’ -Use -v to see a list of the files searched for. +Use -v (or `:set -v` in ghci) to see a list of the files searched for. diff --git a/testsuite/tests/plugins/plugins04.stderr b/testsuite/tests/plugins/plugins04.stderr index f0acc67d22..46c0f9ce55 100644 --- a/testsuite/tests/plugins/plugins04.stderr +++ b/testsuite/tests/plugins/plugins04.stderr @@ -1,2 +1,2 @@ Module imports form a cycle: - module ‘HomePackagePlugin’ (./HomePackagePlugin.hs) imports itself + module ‘HomePackagePlugin’ (./HomePackagePlugin.hs) imports itself
\ No newline at end of file diff --git a/testsuite/tests/plugins/plugins08.hs b/testsuite/tests/plugins/plugins08.hs new file mode 100644 index 0000000000..403d81f076 --- /dev/null +++ b/testsuite/tests/plugins/plugins08.hs @@ -0,0 +1,18 @@ +-- Tests a plugin added with TH.addCorePlugin +{-# LANGUAGE TemplateHaskell #-} +module Main where + +import Simple.DataStructures +import Language.Haskell.TH.Syntax + +do addCorePlugin "Simple.Plugin" + return [] + +{-# ANN theMessage (ReplaceWith "Right") #-} +{-# NOINLINE theMessage #-} +theMessage = "Wrong" + +main = do + putStrLn "Program Started" + putStrLn theMessage + putStrLn "Program Ended" diff --git a/testsuite/tests/plugins/plugins08.stderr b/testsuite/tests/plugins/plugins08.stderr new file mode 100644 index 0000000000..72667a052f --- /dev/null +++ b/testsuite/tests/plugins/plugins08.stderr @@ -0,0 +1,4 @@ +Simple Plugin Passes Queried +Got options: +Simple Plugin Pass Run +Performing Replacement diff --git a/testsuite/tests/plugins/plugins08.stdout b/testsuite/tests/plugins/plugins08.stdout new file mode 100644 index 0000000000..5633757f84 --- /dev/null +++ b/testsuite/tests/plugins/plugins08.stdout @@ -0,0 +1,3 @@ +Program Started +Right +Program Ended diff --git a/testsuite/tests/plugins/plugins09.hs b/testsuite/tests/plugins/plugins09.hs new file mode 100644 index 0000000000..d843c00b78 --- /dev/null +++ b/testsuite/tests/plugins/plugins09.hs @@ -0,0 +1 @@ +module A where diff --git a/testsuite/tests/plugins/plugins09.stdout b/testsuite/tests/plugins/plugins09.stdout new file mode 100644 index 0000000000..885850e598 --- /dev/null +++ b/testsuite/tests/plugins/plugins09.stdout @@ -0,0 +1,9 @@ +parsePlugin(a,b) +interfacePlugin: Prelude +interfacePlugin: GHC.Float +interfacePlugin: GHC.Base +typeCheckPlugin (rn) +interfacePlugin: GHC.Types +typeCheckPlugin (tc) +interfacePlugin: GHC.Integer.Type +interfacePlugin: GHC.Natural diff --git a/testsuite/tests/plugins/plugins10.hs b/testsuite/tests/plugins/plugins10.hs new file mode 100644 index 0000000000..d4564a2c29 --- /dev/null +++ b/testsuite/tests/plugins/plugins10.hs @@ -0,0 +1,9 @@ +{-# OPTIONS_GHC -fplugin-opt Simple.SourcePlugin:a #-} +{-# LANGUAGE TemplateHaskell, QuasiQuotes #-} +module B where + +import QuasiQuotation + +$(return []) + +x = [stringify|x|] diff --git a/testsuite/tests/plugins/plugins10.stdout b/testsuite/tests/plugins/plugins10.stdout new file mode 100644 index 0000000000..737789cc56 --- /dev/null +++ b/testsuite/tests/plugins/plugins10.stdout @@ -0,0 +1,18 @@ +parsePlugin() +interfacePlugin: Prelude +interfacePlugin: Language.Haskell.TH +interfacePlugin: Language.Haskell.TH.Quote +interfacePlugin: GHC.Float +interfacePlugin: GHC.Base +interfacePlugin: Language.Haskell.TH.Syntax +interfacePlugin: GHC.Types +typeCheckPlugin (rn) +typeCheckPlugin (tc) +interfacePlugin: GHC.Integer.Type +parsePlugin(a) +interfacePlugin: Language.Haskell.TH.Lib.Internal +metaPlugin: return [] +metaPlugin: quoteExp stringify "x" +interfacePlugin: GHC.CString +typeCheckPlugin (rn) +typeCheckPlugin (tc)
\ No newline at end of file diff --git a/testsuite/tests/plugins/plugins11.hs b/testsuite/tests/plugins/plugins11.hs new file mode 100644 index 0000000000..f714472a07 --- /dev/null +++ b/testsuite/tests/plugins/plugins11.hs @@ -0,0 +1,2 @@ +{-# OPTIONS_GHC -fplugin Simple.SourcePlugin #-} +module A where diff --git a/testsuite/tests/plugins/plugins11.stdout b/testsuite/tests/plugins/plugins11.stdout new file mode 100644 index 0000000000..8e0dca4335 --- /dev/null +++ b/testsuite/tests/plugins/plugins11.stdout @@ -0,0 +1,9 @@ +parsePlugin() +interfacePlugin: Prelude +interfacePlugin: GHC.Float +interfacePlugin: GHC.Base +typeCheckPlugin (rn) +interfacePlugin: GHC.Types +typeCheckPlugin (tc) +interfacePlugin: GHC.Integer.Type +interfacePlugin: GHC.Natural diff --git a/testsuite/tests/plugins/plugins12.hs b/testsuite/tests/plugins/plugins12.hs new file mode 100644 index 0000000000..96d35db179 --- /dev/null +++ b/testsuite/tests/plugins/plugins12.hs @@ -0,0 +1,9 @@ +{-# OPTIONS_GHC -fplugin Simple.RemovePlugin #-} +{-# OPTIONS_GHC -fplugin-opt Simple.RemovePlugin:map #-} +{-# OPTIONS_GHC -fplugin-opt Simple.RemovePlugin:parse #-} +-- testing that the plugin can alter the parsed representation +module A where + +map x = () + +x = map show [1,2,3] diff --git a/testsuite/tests/plugins/plugins13.hs b/testsuite/tests/plugins/plugins13.hs new file mode 100644 index 0000000000..273aba2df9 --- /dev/null +++ b/testsuite/tests/plugins/plugins13.hs @@ -0,0 +1,5 @@ +module A where + +import PluginFilteredExport + +x = map show [1,2,3] diff --git a/testsuite/tests/plugins/plugins14.hs b/testsuite/tests/plugins/plugins14.hs new file mode 100644 index 0000000000..6f4c2f5780 --- /dev/null +++ b/testsuite/tests/plugins/plugins14.hs @@ -0,0 +1,11 @@ +{-# OPTIONS_GHC -fplugin Simple.RemovePlugin #-} +{-# OPTIONS_GHC -fplugin-opt Simple.RemovePlugin:map #-} +{-# OPTIONS_GHC -fplugin-opt Simple.RemovePlugin:interface #-} +module A where +-- test if a definition can be removed from loaded interface + +map :: () +map = () + +x :: () +x = map diff --git a/testsuite/tests/plugins/plugins15.hs b/testsuite/tests/plugins/plugins15.hs new file mode 100644 index 0000000000..be760192ae --- /dev/null +++ b/testsuite/tests/plugins/plugins15.hs @@ -0,0 +1,12 @@ +{-# OPTIONS_GHC -fplugin Simple.RemovePlugin #-} +{-# OPTIONS_GHC -fplugin-opt Simple.RemovePlugin:clear #-} +{-# OPTIONS_GHC -fplugin-opt Simple.RemovePlugin:meta #-} +{-# LANGUAGE TemplateHaskell #-} +-- testing that the plugin can alter the evaluated splice +module A where + +import MetaRemoveHelper + +$(clear [d| a = () |]) + +x = a diff --git a/testsuite/tests/plugins/simple-plugin/Simple/Plugin.hs b/testsuite/tests/plugins/simple-plugin/Simple/Plugin.hs index e8c2435849..94cb74b151 100644 --- a/testsuite/tests/plugins/simple-plugin/Simple/Plugin.hs +++ b/testsuite/tests/plugins/simple-plugin/Simple/Plugin.hs @@ -16,14 +16,15 @@ import qualified Language.Haskell.TH as TH plugin :: Plugin plugin = defaultPlugin { - installCoreToDos = install + installCoreToDos = install, + pluginRecompile = purePlugin } install :: [CommandLineOption] -> [CoreToDo] -> CoreM [CoreToDo] install options todos = do putMsgS $ "Simple Plugin Passes Queried" putMsgS $ "Got options: " ++ unwords options - + -- Create some actual passes to continue the test. return $ CoreDoPluginPass "Main pass" mainPass : todos @@ -36,7 +37,7 @@ findNameBind target (NonRec b e) = findNameBndr target b findNameBind target (Rec bes) = mconcat (map (findNameBndr target . fst) bes) findNameBndr :: String -> CoreBndr -> First Name -findNameBndr target b +findNameBndr target b = if getOccString (varName b) == target then First (Just (varName b)) else First Nothing diff --git a/testsuite/tests/plugins/simple-plugin/Simple/RemovePlugin.hs b/testsuite/tests/plugins/simple-plugin/Simple/RemovePlugin.hs new file mode 100644 index 0000000000..2d14eeaf85 --- /dev/null +++ b/testsuite/tests/plugins/simple-plugin/Simple/RemovePlugin.hs @@ -0,0 +1,69 @@ +{-# LANGUAGE TypeFamilies, FlexibleContexts #-} +module Simple.RemovePlugin where + +import Control.Monad.IO.Class +import Data.List (intercalate) +import Plugins +import Bag +import HscTypes +import TcRnTypes +import HsExtension +import HsExpr +import Outputable +import SrcLoc +import HsSyn +import HsBinds +import OccName +import RdrName +import Name +import Avail + +plugin :: Plugin +plugin = defaultPlugin { parsedResultAction = parsedPlugin + , typeCheckResultAction = typecheckPlugin + , spliceRunAction = metaPlugin' + , interfaceLoadAction = interfaceLoadPlugin' + } + +parsedPlugin :: [CommandLineOption] -> ModSummary -> HsParsedModule + -> Hsc HsParsedModule +parsedPlugin [name, "parse"] _ pm + = return $ pm { hpm_module = removeParsedBinding name (hpm_module pm) } +parsedPlugin _ _ pm = return pm + +removeParsedBinding :: String -> Located (HsModule GhcPs) + -> Located (HsModule GhcPs) +removeParsedBinding name (L l m) + = (L l (m { hsmodDecls = filter (notNamedAs name) (hsmodDecls m) } )) + where notNamedAs name (L _ (ValD _ (FunBind { fun_id = L _ fid }))) + = occNameString (rdrNameOcc fid) /= name + notNamedAs _ _ = True + +typecheckPlugin :: [CommandLineOption] -> ModSummary -> TcGblEnv -> TcM TcGblEnv +typecheckPlugin [name, "typecheck"] _ tc + = return $ tc { tcg_exports = filter (availNotNamedAs name) (tcg_exports tc) + , tcg_binds = filterBag (notNamedAs name) (tcg_binds tc) + } + where notNamedAs name (L _ FunBind { fun_id = L _ fid }) + = occNameString (getOccName fid) /= name + notNamedAs name (L _ AbsBinds { abs_binds = bnds }) + = all (notNamedAs name) bnds + notNamedAs _ (L _ b) = True +typecheckPlugin _ _ tc = return tc + +metaPlugin' :: [CommandLineOption] -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc) +metaPlugin' [name, "meta"] (L _ (HsApp noExt (L l (HsVar _ (L _ id))) e)) + | occNameString (getOccName id) == name + = return e +metaPlugin' _ meta = return meta + +interfaceLoadPlugin' :: [CommandLineOption] -> ModIface -> IfM lcl ModIface +interfaceLoadPlugin' [name, "interface"] iface + = return $ iface { mi_exports = filter (availNotNamedAs name) + (mi_exports iface) + } +interfaceLoadPlugin' _ iface = return iface + +availNotNamedAs :: String -> AvailInfo -> Bool +availNotNamedAs name avail + = occNameString (getOccName (availName avail)) /= name diff --git a/testsuite/tests/plugins/simple-plugin/Simple/SourcePlugin.hs b/testsuite/tests/plugins/simple-plugin/Simple/SourcePlugin.hs new file mode 100644 index 0000000000..b9bdaeb37a --- /dev/null +++ b/testsuite/tests/plugins/simple-plugin/Simple/SourcePlugin.hs @@ -0,0 +1,52 @@ +module Simple.SourcePlugin where + +import Control.Monad.IO.Class +import Data.List (intercalate) +import Data.Maybe (isJust) +import Plugins +import HscTypes +import TcRnTypes +import HsExtension +import Avail +import HsExpr +import Outputable +import HsImpExp +import HsDecls +import HsDoc + +plugin :: Plugin +plugin = defaultPlugin { parsedResultAction = parsedPlugin + , typeCheckResultAction = typecheckPlugin + , spliceRunAction = metaPlugin' + , interfaceLoadAction = interfaceLoadPlugin' + , renamedResultAction = renamedAction + } + +parsedPlugin :: [CommandLineOption] -> ModSummary -> HsParsedModule + -> Hsc HsParsedModule +parsedPlugin opts _ pm + = do liftIO $ putStrLn $ "parsePlugin(" ++ intercalate "," opts ++ ")" + return pm + +renamedAction :: [CommandLineOption] + -> TcGblEnv -> HsGroup GhcRn + -> TcM (TcGblEnv, HsGroup GhcRn) +renamedAction _ env grp + = do liftIO $ putStrLn "typeCheckPlugin (rn)" + return (env, grp) + +typecheckPlugin :: [CommandLineOption] -> ModSummary -> TcGblEnv -> TcM TcGblEnv +typecheckPlugin _ _ tc + = do liftIO $ putStrLn "typeCheckPlugin (tc)" + return tc + +metaPlugin' :: [CommandLineOption] -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc) +metaPlugin' _ meta + = do liftIO $ putStrLn $ "metaPlugin: " ++ (showSDocUnsafe $ ppr meta) + return meta + +interfaceLoadPlugin' :: [CommandLineOption] -> ModIface -> IfM lcl ModIface +interfaceLoadPlugin' _ iface + = do liftIO $ putStrLn $ "interfacePlugin: " + ++ (showSDocUnsafe $ ppr $ mi_module iface) + return iface diff --git a/testsuite/tests/plugins/simple-plugin/simple-plugin.cabal b/testsuite/tests/plugins/simple-plugin/simple-plugin.cabal index 011ed67e23..0a3c49e988 100644 --- a/testsuite/tests/plugins/simple-plugin/simple-plugin.cabal +++ b/testsuite/tests/plugins/simple-plugin/simple-plugin.cabal @@ -17,4 +17,6 @@ Library Exposed-Modules: Simple.Plugin Simple.BadlyTypedPlugin - Simple.DataStructures
\ No newline at end of file + Simple.DataStructures + Simple.SourcePlugin + Simple.RemovePlugin diff --git a/testsuite/tests/pmcheck/complete_sigs/T14059a.hs b/testsuite/tests/pmcheck/complete_sigs/T14059a.hs new file mode 100644 index 0000000000..6128a8beaa --- /dev/null +++ b/testsuite/tests/pmcheck/complete_sigs/T14059a.hs @@ -0,0 +1,23 @@ +{-# LANGUAGE GADTs #-} +{-# LANGUAGE PatternSynonyms #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeInType #-} +{-# LANGUAGE TypeOperators #-} +{-# OPTIONS_GHC -Wincomplete-patterns #-} +module T14059a where + +data SBool (z :: Bool) where + SFalse :: SBool False + STrue :: SBool True + +pattern STooGoodToBeTrue :: forall (z :: Bool). () + => z ~ True + => SBool z +pattern STooGoodToBeTrue = STrue +{-# COMPLETE SFalse, STooGoodToBeTrue #-} + +wibble :: SBool z -> Bool +wibble STrue = True + +wobble :: SBool z -> Bool +wobble STooGoodToBeTrue = True diff --git a/testsuite/tests/pmcheck/complete_sigs/T14059a.stderr b/testsuite/tests/pmcheck/complete_sigs/T14059a.stderr new file mode 100644 index 0000000000..4a52c97dfe --- /dev/null +++ b/testsuite/tests/pmcheck/complete_sigs/T14059a.stderr @@ -0,0 +1,8 @@ + +T14059a.hs:20:1: warning: [-Wincomplete-patterns (in -Wextra)] + Pattern match(es) are non-exhaustive + In an equation for ‘wibble’: Patterns not matched: SFalse + +T14059a.hs:23:1: warning: [-Wincomplete-patterns (in -Wextra)] + Pattern match(es) are non-exhaustive + In an equation for ‘wobble’: Patterns not matched: SFalse diff --git a/testsuite/tests/pmcheck/complete_sigs/T14253.hs b/testsuite/tests/pmcheck/complete_sigs/T14253.hs new file mode 100644 index 0000000000..bb56d437bf --- /dev/null +++ b/testsuite/tests/pmcheck/complete_sigs/T14253.hs @@ -0,0 +1,39 @@ +{-# LANGUAGE GADTs #-} +{-# LANGUAGE PatternSynonyms #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE PolyKinds #-} + +module T14253 where + +import GHC.Exts +import Data.Kind + +data TypeRep (a :: k) where + Con :: TypeRep (a :: k) + TrFun :: forall (r1 :: RuntimeRep) (r2 :: RuntimeRep) + (a :: TYPE r1) (b :: TYPE r2). + TypeRep a + -> TypeRep b + -> TypeRep (a -> b) + +pattern Fun :: forall k (fun :: k). () + => forall (r1 :: RuntimeRep) (r2 :: RuntimeRep) + (arg :: TYPE r1) (res :: TYPE r2). + (k ~ Type, fun ~~ (arg -> res)) + => TypeRep arg + -> TypeRep res + -> TypeRep fun +pattern Fun arg res <- TrFun arg res + +data Dynamic where + Dynamic :: forall a. TypeRep a -> a -> Dynamic + +-- Adding this results in failure +{-# COMPLETE Con #-} + +dynApply :: Dynamic -> Dynamic -> Maybe Dynamic +-- Changing TrFun to Fun also results in failure +dynApply (Dynamic (Fun ta tr) f) (Dynamic ta' x) = undefined +dynApply _ _ = Nothing + diff --git a/testsuite/tests/pmcheck/complete_sigs/all.T b/testsuite/tests/pmcheck/complete_sigs/all.T index 4e8c33d9be..d58c182f8e 100644 --- a/testsuite/tests/pmcheck/complete_sigs/all.T +++ b/testsuite/tests/pmcheck/complete_sigs/all.T @@ -13,3 +13,5 @@ test('completesig12', normal, compile, ['']) test('completesig13', normal, compile, ['']) test('completesig14', normal, compile, ['']) test('completesig15', normal, compile_fail, ['']) +test('T14059a', normal, compile, ['']) +test('T14253', expect_broken(14253), compile, ['']) diff --git a/testsuite/tests/pmcheck/should_compile/T11195.hs b/testsuite/tests/pmcheck/should_compile/T11195.hs index 236932e86f..0c35b4fd27 100644 --- a/testsuite/tests/pmcheck/should_compile/T11195.hs +++ b/testsuite/tests/pmcheck/should_compile/T11195.hs @@ -62,7 +62,7 @@ opt_transList :: InScopeSet -> [NormalCo] -> [NormalCo] -> [NormalCo] opt_transList is = zipWith (opt_trans is) opt_trans_rule :: InScopeSet -> NormalNonIdCo -> NormalNonIdCo -> Maybe NormalCo -opt_trans_rule is in_co1@(NthCo d1 co1) in_co2@(NthCo d2 co2) +opt_trans_rule is in_co1@(NthCo r1 d1 co1) in_co2@(NthCo r2 d2 co2) | d1 == d2 , co1 `compatible_co` co2 = undefined diff --git a/testsuite/tests/pmcheck/should_compile/T11984.hs b/testsuite/tests/pmcheck/should_compile/T11984.hs new file mode 100644 index 0000000000..b655df0efe --- /dev/null +++ b/testsuite/tests/pmcheck/should_compile/T11984.hs @@ -0,0 +1,23 @@ +{-# LANGUAGE PolyKinds, TypeOperators, DataKinds, TypeFamilies, GADTs #-} + +module T11984 where + +data family Sing (a :: k) + +data Schema = Sch [Bool] + +data instance Sing (x :: Schema) where + SSch :: Sing x -> Sing ('Sch x) + +data instance Sing (x :: [k]) where + SNil :: Sing '[] + SCons :: Sing a -> Sing b -> Sing (a ': b) + +data G a where + GCons :: G ('Sch (a ': b)) + +eval :: G s -> Sing s -> () +eval GCons s = + case s of + -- SSch SNil -> undefined + SSch (SCons _ _) -> undefined diff --git a/testsuite/tests/pmcheck/should_compile/T14086.hs b/testsuite/tests/pmcheck/should_compile/T14086.hs new file mode 100644 index 0000000000..5e69ce6a33 --- /dev/null +++ b/testsuite/tests/pmcheck/should_compile/T14086.hs @@ -0,0 +1,6 @@ +{-# language EmptyCase #-} +module T14086 where +import Data.Kind + +f :: Type -> Int +f x = case x of diff --git a/testsuite/tests/pmcheck/should_compile/T14098.hs b/testsuite/tests/pmcheck/should_compile/T14098.hs new file mode 100644 index 0000000000..ecb01029eb --- /dev/null +++ b/testsuite/tests/pmcheck/should_compile/T14098.hs @@ -0,0 +1,24 @@ +{-# Language GADTs #-} +module T14098 where + +data App f a where + App :: f a -> App f (Maybe a) + +data Ty a where + TBool :: Ty Bool + TInt :: Ty Int + +data T f a where + C :: T Ty (Maybe Bool) + +f1 :: T f a -> App f a -> () +f1 C (App TBool) = () + +f2 :: T f a -> App f a -> () +f2 C (App x) + | TBool <- x + = () + +g :: T f a -> App f a -> () +g C (App x) = case x of + TBool -> () diff --git a/testsuite/tests/pmcheck/should_compile/T15305.hs b/testsuite/tests/pmcheck/should_compile/T15305.hs new file mode 100644 index 0000000000..82214b7e19 --- /dev/null +++ b/testsuite/tests/pmcheck/should_compile/T15305.hs @@ -0,0 +1,58 @@ +{-# LANGUAGE EmptyCase #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} +module T15305 where + +import Data.Void + +-- Example 1 + +data (:+:) f g a = Inl !(f a) | Inr !(g a) + +data A +data B + +data Foo l where + Foo :: Foo A + +data Bar l where + Bar :: Bar B + +type Sig = Foo :+: Bar + +fun :: Sig B -> Int +fun (Inr Bar) = 1 + +-- Example 2 + +data GhcPass c +type family XXHsImplicitBndrs x +type instance XXHsImplicitBndrs (GhcPass _) = Void + +data HsImplicitBndrs pass + = UsefulConstructor + | XHsImplicitBndrs !(XXHsImplicitBndrs pass) + +fun2 :: HsImplicitBndrs (GhcPass pass) -> () +fun2 UsefulConstructor = () +{- +NB: the seemingly equivalent function + +fun2' :: (p ~ GhcPass pass) => HsImplicitBndrs p -> () +fun2' UsefulConstructor = () + +Is mistakenly deemed non-exhaustive at the moment due to #14813. +-} + +-- Example 3 + +data Abyss = MkAbyss !Abyss + +stareIntoTheAbyss :: Abyss -> a +stareIntoTheAbyss x = case x of {} +{- +Alas, this function is marked non-exhaustive, since the way GHC solves +NonVoid constraints at the moment isn't sophisticated enough to handle +recursive strict argument types like MkAbyss exhibits. Maybe some day. +-} diff --git a/testsuite/tests/pmcheck/should_compile/T15305.stderr b/testsuite/tests/pmcheck/should_compile/T15305.stderr new file mode 100644 index 0000000000..bb88a9be5b --- /dev/null +++ b/testsuite/tests/pmcheck/should_compile/T15305.stderr @@ -0,0 +1,4 @@ + +T15305.hs:53:23: warning: [-Wincomplete-patterns (in -Wextra)] + Pattern match(es) are non-exhaustive + In a case alternative: Patterns not matched: (MkAbyss _) diff --git a/testsuite/tests/pmcheck/should_compile/T15385.hs b/testsuite/tests/pmcheck/should_compile/T15385.hs new file mode 100644 index 0000000000..dedf6c1553 --- /dev/null +++ b/testsuite/tests/pmcheck/should_compile/T15385.hs @@ -0,0 +1,21 @@ +{-# LANGUAGE GADTs #-} +{-# LANGUAGE MultiWayIf #-} +{-# LANGUAGE TypeOperators #-} +{-# OPTIONS_GHC -Wincomplete-patterns #-} +module T15385 where + +import Data.Type.Equality + +data T a where + TInt :: T Int + TBool :: T Bool + +f1, f2 :: a :~: Int -> T a -> () +f1 eq t + | Refl <- eq + = case t of + TInt -> () +f2 eq t + = if | Refl <- eq + -> case t of + TInt -> () diff --git a/testsuite/tests/pmcheck/should_compile/T15450.hs b/testsuite/tests/pmcheck/should_compile/T15450.hs new file mode 100644 index 0000000000..100c8e8f7e --- /dev/null +++ b/testsuite/tests/pmcheck/should_compile/T15450.hs @@ -0,0 +1,9 @@ +{-# LANGUAGE EmptyCase #-} +{-# LANGUAGE GADTs #-} +module T15450 where + +f :: (Int ~ Bool) => Bool -> a +f x = case x of {} + +g :: (Int ~ Bool) => Bool -> a +g x = case x of True -> undefined diff --git a/testsuite/tests/pmcheck/should_compile/T15450.stderr b/testsuite/tests/pmcheck/should_compile/T15450.stderr new file mode 100644 index 0000000000..e9a320fb3c --- /dev/null +++ b/testsuite/tests/pmcheck/should_compile/T15450.stderr @@ -0,0 +1,11 @@ + +T15450.hs:6:7: warning: [-Wincomplete-patterns (in -Wextra)] + Pattern match(es) are non-exhaustive + In a case alternative: + Patterns not matched: + False + True + +T15450.hs:9:7: warning: [-Wincomplete-patterns (in -Wextra)] + Pattern match(es) are non-exhaustive + In a case alternative: Patterns not matched: False diff --git a/testsuite/tests/pmcheck/should_compile/T15584.hs b/testsuite/tests/pmcheck/should_compile/T15584.hs new file mode 100644 index 0000000000..c5d38bb32f --- /dev/null +++ b/testsuite/tests/pmcheck/should_compile/T15584.hs @@ -0,0 +1,15 @@ +{-# LANGUAGE EmptyCase #-} +{-# OPTIONS -Wincomplete-patterns #-} +module T15584 where + +import Data.Void + +data V = MkV !Void +data S1 = MkS1 !V +newtype S2 = MkS2 V + +s1 :: S1 -> a +s1 x = case x of {} + +s2 :: S2 -> a +s2 x = case x of {} diff --git a/testsuite/tests/pmcheck/should_compile/T3927b.hs b/testsuite/tests/pmcheck/should_compile/T3927b.hs index 89b81534c7..d4cfa1e275 100644 --- a/testsuite/tests/pmcheck/should_compile/T3927b.hs +++ b/testsuite/tests/pmcheck/should_compile/T3927b.hs @@ -11,8 +11,8 @@ module T3927b where +import Data.Kind (Type, Constraint) import Data.Proxy -import GHC.Exts data Message @@ -30,16 +30,16 @@ type family Implements (t :: SocketType) :: [SocketOperation] where Implements Push = '[Write] Implements Pull = '[ 'Read] -data SockOp :: SocketType -> SocketOperation -> * where +data SockOp :: SocketType -> SocketOperation -> Type where SRead :: SockOp sock 'Read SWrite :: SockOp sock Write -data Socket :: SocketType -> * where +data Socket :: SocketType -> Type where Socket :: proxy sock -> (forall op . Restrict op (Implements sock) => SockOp sock op -> Operation op) -> Socket sock -type family Operation (op :: SocketOperation) :: * where +type family Operation (op :: SocketOperation) :: Type where Operation 'Read = IO Message Operation Write = Message -> IO () diff --git a/testsuite/tests/pmcheck/should_compile/all.T b/testsuite/tests/pmcheck/should_compile/all.T index f44034b0d2..20eef3ff95 100644 --- a/testsuite/tests/pmcheck/should_compile/all.T +++ b/testsuite/tests/pmcheck/should_compile/all.T @@ -37,10 +37,40 @@ test('T9951b', [], compile, test('T9951', [], compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) test('T11303', normal, compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns +RTS -M1G -RTS']) -test('T11276', compile_timeout_multiplier(0.01), compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns +RTS -M1G -RTS']) -test('T11303b', compile_timeout_multiplier(0.01), compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns +RTS -M1G -RTS']) -test('T11374', compile_timeout_multiplier(0.01), compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns +RTS -M1G -RTS']) -test('T11195', compile_timeout_multiplier(0.60), compile, ['-package ghc -fwarn-incomplete-patterns -fwarn-overlapping-patterns +RTS -M2G -RTS']) +test('T11276', compiler_stats_num_field('bytes allocated', + [(wordsize(64), 165890392, 10)] + # 2018-07-14: 165890392 INITIAL + ), compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns +RTS -M1G -RTS']) + +test('T11303b', compiler_stats_num_field('bytes allocated', + [(wordsize(64), 54373936, 10)] + # 2018-07-14: 54373936 INITIAL + ), compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns +RTS -M1G -RTS']) + +test('T11374', compiler_stats_num_field('bytes allocated', + [(wordsize(64), 280144864, 10)] + # 2018-07-14: 280144864 INITIAL + ), compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns +RTS -M1G -RTS']) + +test('T11195', compiler_stats_num_field('bytes allocated', + [(wordsize(64), 7852567480, 10)] + # 2018-07-14: 7852567480 INITIAL + ), compile, ['-package ghc -fwarn-incomplete-patterns -fwarn-overlapping-patterns +RTS -M2G -RTS']) + +test('T11984', normal, compile, + ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) +test('T14086', normal, compile, + ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) +test('T14098', normal, compile, + ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) +test('T15305', normal, compile, + ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) +test('T15385', normal, compile, + ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) +test('T15450', normal, compile, + ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) +test('T15584', normal, compile, + ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) # Other tests test('pmc001', [], compile, diff --git a/testsuite/tests/polykinds/BadKindVar.hs b/testsuite/tests/polykinds/BadKindVar.hs new file mode 100644 index 0000000000..c24657f3d2 --- /dev/null +++ b/testsuite/tests/polykinds/BadKindVar.hs @@ -0,0 +1,9 @@ +{-# LANGUAGE RankNTypes, KindSignatures #-} + +module Foo where + +import Data.Proxy + +-- Should be illegal without PolyKinds +f :: forall (a :: k). Proxy a +f = f diff --git a/testsuite/tests/polykinds/BadKindVar.stderr b/testsuite/tests/polykinds/BadKindVar.stderr new file mode 100644 index 0000000000..beeed2b3c8 --- /dev/null +++ b/testsuite/tests/polykinds/BadKindVar.stderr @@ -0,0 +1,5 @@ + +BadKindVar.hs:8:19: error: + Unexpected kind variable ‘k’ + Perhaps you intended to use PolyKinds + In the type signature for ‘f’ diff --git a/testsuite/tests/polykinds/KindVType.stderr b/testsuite/tests/polykinds/KindVType.stderr index 7ce3404579..27e2e588a5 100644 --- a/testsuite/tests/polykinds/KindVType.stderr +++ b/testsuite/tests/polykinds/KindVType.stderr @@ -1,6 +1,6 @@ KindVType.hs:8:8: error: - • Couldn't match type ‘*’ with ‘* -> *’ + • Couldn't match type ‘Int’ with ‘Maybe’ Expected type: Proxy Maybe Actual type: Proxy Int • In the expression: (Proxy :: Proxy Int) diff --git a/testsuite/tests/polykinds/MonoidsFD.hs b/testsuite/tests/polykinds/MonoidsFD.hs index f093d77663..67be60d60a 100644 --- a/testsuite/tests/polykinds/MonoidsFD.hs +++ b/testsuite/tests/polykinds/MonoidsFD.hs @@ -15,6 +15,7 @@ module Main where import Control.Monad (Monad(..), join, ap) import Data.Monoid (Monoid(..)) +import Data.Semigroup (Semigroup(..)) -- First we define the type class Monoidy: @@ -81,9 +82,11 @@ test2 = print (Sum 1 <+> Sum 2 <+> Sum 4) -- Sum 7 -- rather cumbersome in actual use. So, we can give traditional Monad and -- Monoid instances for instances of Monoidy: +instance Monoidy (→) (,) () m ⇒ Semigroup m where + (<>) = curry mjoin + instance Monoidy (→) (,) () m ⇒ Monoid m where mempty = munit () - mappend = curry mjoin instance Applicative Wrapper where pure = return diff --git a/testsuite/tests/polykinds/MonoidsTF.hs b/testsuite/tests/polykinds/MonoidsTF.hs index 9097e53af2..8e3b378046 100644 --- a/testsuite/tests/polykinds/MonoidsTF.hs +++ b/testsuite/tests/polykinds/MonoidsTF.hs @@ -12,12 +12,15 @@ {-# LANGUAGE TypeFamilies #-} module Main where + +import Data.Kind import Control.Monad (Monad(..), join, ap, liftM) import Data.Monoid (Monoid(..)) +import Data.Semigroup (Semigroup(..)) -- First we define the type class Monoidy: -class Monoidy (to :: k0 -> k1 -> *) (m :: k1) where +class Monoidy (to :: k0 -> k1 -> Type) (m :: k1) where type MComp to m :: k1 -> k1 -> k0 type MId to m :: k0 munit :: MId to m `to` m @@ -91,10 +94,13 @@ test2 = print (Sum 1 <+> Sum 2 <+> Sum 4) -- Sum 7 -- rather cumbersome in actual use. So, we can give traditional Monad and -- Monoid instances for instances of Monoidy: -instance (MId (→) m ~ (), MComp (→) m ~ (,), Monoidy (→) m) +instance (MId (→) m ~ (), MComp (→) m ~ (,), Monoidy (→) m) + ⇒ Semigroup m where + (<>) = curry mjoin + +instance (MId (→) m ~ (), MComp (→) m ~ (,), Monoidy (→) m) ⇒ Monoid m where mempty = munit () - mappend = curry mjoin instance Applicative Wrapper where pure = return diff --git a/testsuite/tests/polykinds/PolyKinds10.hs b/testsuite/tests/polykinds/PolyKinds10.hs index b023fd092f..70c5d70606 100644 --- a/testsuite/tests/polykinds/PolyKinds10.hs +++ b/testsuite/tests/polykinds/PolyKinds10.hs @@ -9,6 +9,7 @@ module Main where +import Data.Kind -- Type-level peano naturals (value-level too, but we don't use those) data Nat = Ze | Su Nat @@ -18,15 +19,15 @@ type T1 = Su T0 type T2 = Su T1 -- (!) at the type level -type family El (n :: Nat) (l :: [*]) :: * +type family El (n :: Nat) (l :: [Type]) :: Type type instance El Ze (h ': t) = h type instance El (Su n) (h ': t) = El n t {- -- The following might be useful, but are not used at the moment -- ($) at the type level (well, not quite ($), in fact...) -class Apply (fs :: [*]) (es :: [*]) where - type ApplyT (fs :: [*]) (es :: [*]) :: [*] +class Apply (fs :: [Type]) (es :: [Type]) where + type ApplyT (fs :: [Type]) (es :: [Type]) :: [Type] apply :: ListV fs -> ListV es -> ListV (ApplyT fs es) instance Apply '[] '[] where @@ -39,11 +40,11 @@ instance (Apply fs es) => Apply ((e1 -> e2) ': fs) (e1 ': es) where -} -- Value mirror for the list kind -data ListV :: [*] -> * where +data ListV :: [Type] -> Type where NilV :: ListV '[] ConsV :: a -> ListV t -> ListV (a ': t) -data ListV2 :: [[*]] -> * where +data ListV2 :: [[Type]] -> Type where NilV2 :: ListV2 '[] ConsV2 :: ListV a -> ListV2 t -> ListV2 (a ': t) @@ -53,26 +54,26 @@ listv1 = ConsV 3 NilV listv2 :: ListV2 ((Int ': '[]) ': '[]) listv2 = ConsV2 listv1 NilV2 ---data ListVX :: Maybe -> * where +--data ListVX :: Maybe -> Type where -data TripleV :: (*, * -> *, *) -> * where +data TripleV :: (Type, Type -> Type, Type) -> Type where TripleV :: a -> c -> TripleV '(a, [], c) -- Value mirror for the Nat kind -data NatV :: Nat -> * where +data NatV :: Nat -> Type where ZeW :: NatV Ze SuW :: NatV n -> NatV (Su n) -- Generic universe data MultiP x = UNIT - | KK x -- wish I could just write * instead of x + | KK x -- wish I could just write Type instead of x | SUM (MultiP x) (MultiP x) | PROD (MultiP x) (MultiP x) | PAR Nat | REC -- Universe interpretation -data Interprt :: MultiP * -> [*] -> * -> * where +data Interprt :: MultiP Type -> [Type] -> Type -> Type where Unit :: Interprt UNIT lp r K :: x -> Interprt (KK x) lp r L :: Interprt a lp r -> Interprt (SUM a b) lp r @@ -83,13 +84,13 @@ data Interprt :: MultiP * -> [*] -> * -> * where -- Embedding values into the universe class Generic a where - type Rep a :: MultiP * - type Es a :: [*] + type Rep a :: MultiP Type + type Es a :: [Type] from :: a -> Interprt (Rep a) (Es a) a to :: Interprt (Rep a) (Es a) a -> a -- Parameter map over the universe -class PMap (rep :: MultiP *) where +class PMap (rep :: MultiP Type) where pmap :: (forall n. NatV n -> El n lp1 -> El n lp2) -> (r -> s) -> Interprt rep lp1 r -> Interprt rep lp2 s diff --git a/testsuite/tests/polykinds/T10134.hs b/testsuite/tests/polykinds/T10134.hs index 0b64625f28..746758ce2f 100644 --- a/testsuite/tests/polykinds/T10134.hs +++ b/testsuite/tests/polykinds/T10134.hs @@ -3,7 +3,7 @@ module T10134 where -import GHC.TypeLits +import GHC.TypeLits as L import T10134a import Prelude @@ -11,9 +11,9 @@ type Positive n = ((n-1)+1)~n data Dummy n d = Dummy { vec :: Vec n (Vec d Bool) } -nextDummy :: Positive (2*(n+d)) => Dummy n d -> Dummy n d +nextDummy :: Positive (2 L.* (n+d)) => Dummy n d -> Dummy n d nextDummy d = Dummy { vec = vec dFst } where (dFst,dSnd) = nextDummy' d -nextDummy' :: Positive (2*(n+d)) => Dummy n d -> ( Dummy n d, Bool ) +nextDummy' :: Positive (2 L.* (n+d)) => Dummy n d -> ( Dummy n d, Bool ) nextDummy' _ = undefined diff --git a/testsuite/tests/polykinds/T10134a.hs b/testsuite/tests/polykinds/T10134a.hs index 0d84d56b5e..9412705e4c 100644 --- a/testsuite/tests/polykinds/T10134a.hs +++ b/testsuite/tests/polykinds/T10134a.hs @@ -4,8 +4,9 @@ {-# LANGUAGE TypeOperators #-} module T10134a where +import Data.Kind (Type) import GHC.TypeLits -data Vec :: Nat -> * -> * where +data Vec :: Nat -> Type -> Type where Nil :: Vec 0 a (:>) :: a -> Vec n a -> Vec (n + 1) a diff --git a/testsuite/tests/polykinds/T10503.stderr b/testsuite/tests/polykinds/T10503.stderr index 731a14b117..2309cdaaae 100644 --- a/testsuite/tests/polykinds/T10503.stderr +++ b/testsuite/tests/polykinds/T10503.stderr @@ -2,8 +2,8 @@ T10503.hs:8:6: error: • Could not deduce: k ~ * from the context: Proxy 'KProxy ~ Proxy 'KProxy - bound by the type signature for: - h :: (Proxy 'KProxy ~ Proxy 'KProxy) => r + bound by a type expected by the context: + (Proxy 'KProxy ~ Proxy 'KProxy) => r at T10503.hs:8:6-85 ‘k’ is a rigid type variable bound by the type signature for: diff --git a/testsuite/tests/polykinds/T10934.hs b/testsuite/tests/polykinds/T10934.hs index fb7a538ebd..35ea20f225 100644 --- a/testsuite/tests/polykinds/T10934.hs +++ b/testsuite/tests/polykinds/T10934.hs @@ -11,6 +11,8 @@ module KeyValue where +import Data.Kind + data AccValidation err a = AccFailure err | AccSuccess a data KeyValueError = MissingValue @@ -23,11 +25,11 @@ missing = rpure missingField missingField :: forall x. (WithKeyValueError :. f) x missingField = Compose $ AccFailure [MissingValue] -data Rec :: (u -> *) -> [u] -> * where +data Rec :: (u -> Type) -> [u] -> Type where RNil :: Rec f '[] (:&) :: !(f r) -> !(Rec f rs) -> Rec f (r ': rs) -newtype Compose (f :: l -> *) (g :: k -> l) (x :: k) +newtype Compose (f :: l -> Type) (g :: k -> l) (x :: k) = Compose { getCompose :: f (g x) } type (:.) f g = Compose f g diff --git a/testsuite/tests/polykinds/T11142.hs b/testsuite/tests/polykinds/T11142.hs index 58eb3b6c94..a96566a371 100644 --- a/testsuite/tests/polykinds/T11142.hs +++ b/testsuite/tests/polykinds/T11142.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE TypeInType, RankNTypes #-} +{-# LANGUAGE PolyKinds, RankNTypes #-} module T11142 where diff --git a/testsuite/tests/polykinds/T11142.stderr b/testsuite/tests/polykinds/T11142.stderr index 2cb4e61f19..a3b40c1222 100644 --- a/testsuite/tests/polykinds/T11142.stderr +++ b/testsuite/tests/polykinds/T11142.stderr @@ -1,7 +1,17 @@ -T11142.hs:9:8: error: - • The kind of variable ‘b’, namely ‘k’, - depends on variable ‘k’ from an inner scope - Perhaps bind ‘b’ sometime after binding ‘k’ - • In the type signature: +T11142.hs:9:49: error: + • Expected kind ‘k1’, but ‘b’ has kind ‘k0’ + • In the second argument of ‘SameKind’, namely ‘b’ + In the type signature: foo :: forall b. (forall k (a :: k). SameKind a b) -> () + +T11142.hs:10:7: error: + • Cannot instantiate unification variable ‘a0’ + with a type involving foralls: + (forall k1 (a :: k1). SameKind a b) -> () + GHC doesn't yet support impredicative polymorphism + • In the expression: undefined + In an equation for ‘foo’: foo = undefined + • Relevant bindings include + foo :: (forall k1 (a :: k1). SameKind a b) -> () + (bound at T11142.hs:10:1) diff --git a/testsuite/tests/polykinds/T11203.hs b/testsuite/tests/polykinds/T11203.hs new file mode 100644 index 0000000000..cff89dff79 --- /dev/null +++ b/testsuite/tests/polykinds/T11203.hs @@ -0,0 +1,7 @@ +{-# LANGUAGE PolyKinds, KindSignatures #-} + +module T11203 where + +data SameKind :: k -> k -> * + +data Q (a :: k1) (b :: k2) c = MkQ (SameKind a b) diff --git a/testsuite/tests/polykinds/T11203.stderr b/testsuite/tests/polykinds/T11203.stderr new file mode 100644 index 0000000000..5d62e00304 --- /dev/null +++ b/testsuite/tests/polykinds/T11203.stderr @@ -0,0 +1,4 @@ + +T11203.hs:7:24: error: + • Couldn't match ‘k1’ with ‘k2’ + • In the data declaration for ‘Q’ diff --git a/testsuite/tests/polykinds/T11399.hs b/testsuite/tests/polykinds/T11399.hs index bc9e60d7f3..56f3c11ef7 100644 --- a/testsuite/tests/polykinds/T11399.hs +++ b/testsuite/tests/polykinds/T11399.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE FlexibleInstances, TypeInType #-} +{-# LANGUAGE FlexibleInstances, PolyKinds #-} module T11399 where import Data.Kind diff --git a/testsuite/tests/polykinds/T11466.stderr b/testsuite/tests/polykinds/T11466.stderr index f584731934..616f317250 100644 --- a/testsuite/tests/polykinds/T11466.stderr +++ b/testsuite/tests/polykinds/T11466.stderr @@ -1,6 +1,4 @@ T11466.hs:15:10: error: • Illegal implicit parameter ‘?x::Int’ - • In the context: Bla - While checking an instance declaration - In the instance declaration for ‘Eq T’ + • In the instance declaration for ‘Eq T’ diff --git a/testsuite/tests/polykinds/T11480b.hs b/testsuite/tests/polykinds/T11480b.hs index 12802e8de3..2684c6de4e 100644 --- a/testsuite/tests/polykinds/T11480b.hs +++ b/testsuite/tests/polykinds/T11480b.hs @@ -21,25 +21,25 @@ module T11480b where -import GHC.Types (Constraint) +import Data.Kind (Constraint, Type) import Data.Type.Equality as Equality import Data.Type.Coercion as Coercion import qualified Prelude import Prelude (Either(..)) -newtype Y (p :: i -> j -> *) (a :: j) (b :: i) = Y { getY :: p b a } +newtype Y (p :: i -> j -> Type) (a :: j) (b :: i) = Y { getY :: p b a } -type family Op (p :: i -> j -> *) :: j -> i -> * where +type family Op (p :: i -> j -> Type) :: j -> i -> Type where Op (Y p) = p Op p = Y p -class Vacuous (p :: i -> i -> *) (a :: i) +class Vacuous (p :: i -> i -> Type) (a :: i) instance Vacuous p a data Dict (p :: Constraint) where Dict :: p => Dict p -class Functor (Op p) (Nat p (->)) p => Category (p :: i -> i -> *) where +class Functor (Op p) (Nat p (->)) p => Category (p :: i -> i -> Type) where type Ob p :: i -> Constraint type Ob p = Vacuous p @@ -62,11 +62,16 @@ class Functor (Op p) (Nat p (->)) p => Category (p :: i -> i -> *) where default unop :: Op p ~ Y p => Op p b a -> p a b unop = getY -class (Category p, Category q) => Functor (p :: i -> i -> *) (q :: j -> j -> *) (f :: i -> j) | f -> p q where +class (Category p, Category q) => + Functor (p :: i -> i -> Type) + (q :: j -> j -> Type) + (f :: i -> j) | f -> p q where fmap :: p a b -> q (f a) (f b) -data Nat (p :: i -> i -> *) (q :: j -> j -> *) (f :: i -> j) (g :: i -> j) where - Nat :: (Functor p q f, Functor p q g) => { runNat :: forall a. Ob p a => q (f a) (g a) } -> Nat p q f g +data Nat (p :: i -> i -> Type) + (q :: j -> j -> Type) (f :: i -> j) (g :: i -> j) where + Nat :: (Functor p q f, Functor p q g) => + { runNat :: forall a. Ob p a => q (f a) (g a) } -> Nat p q f g instance (Category p, Category q) => Category (Nat p q) where type Ob (Nat p q) = Functor p q @@ -80,7 +85,8 @@ instance (Category p, Category q) => Category (Nat p q) where ob :: forall p q f a. Functor p q f => Ob p a :- Ob q (f a) ob = Sub (case source (fmap (id :: p a a) :: q (f a) (f a)) of Dict -> Dict) -instance (Category p, Category q) => Functor (Y (Nat p q)) (Nat (Nat p q) (->)) (Nat p q) where +instance (Category p, Category q) => + Functor (Y (Nat p q)) (Nat (Nat p q) (->)) (Nat p q) where fmap (Y f) = Nat (. f) instance (Category p, Category q) => Functor (Nat p q) (->) (Nat p q f) where diff --git a/testsuite/tests/polykinds/T11516.hs b/testsuite/tests/polykinds/T11516.hs index 3b19a997f9..66feeec387 100644 --- a/testsuite/tests/polykinds/T11516.hs +++ b/testsuite/tests/polykinds/T11516.hs @@ -3,6 +3,7 @@ {-# language ConstraintKinds #-} {-# language FlexibleInstances #-} {-# language FunctionalDependencies #-} +{-# language UndecidableInstances #-} import GHC.Exts (Constraint) diff --git a/testsuite/tests/polykinds/T11516.stderr b/testsuite/tests/polykinds/T11516.stderr index 5db11c8f83..5f8083309c 100644 --- a/testsuite/tests/polykinds/T11516.stderr +++ b/testsuite/tests/polykinds/T11516.stderr @@ -1,5 +1,5 @@ -T11516.hs:11:16: error: +T11516.hs:12:16: error: • Expected kind ‘i0 -> i0 -> *’, but ‘()’ has kind ‘*’ • In the first argument of ‘Varpi’, namely ‘()’ In the instance declaration for ‘Varpi (->) (->) (Either f)’ diff --git a/testsuite/tests/polykinds/T11520.hs b/testsuite/tests/polykinds/T11520.hs index fa5a3bf4a4..9c1d4fe1be 100644 --- a/testsuite/tests/polykinds/T11520.hs +++ b/testsuite/tests/polykinds/T11520.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE RankNTypes, PolyKinds, TypeInType, GADTs, UndecidableSuperClasses #-} +{-# LANGUAGE RankNTypes, PolyKinds, GADTs, UndecidableSuperClasses, UndecidableInstances #-} module T11520 where diff --git a/testsuite/tests/polykinds/T11520.stderr b/testsuite/tests/polykinds/T11520.stderr index 11a81baf62..93078aa23c 100644 --- a/testsuite/tests/polykinds/T11520.stderr +++ b/testsuite/tests/polykinds/T11520.stderr @@ -1,4 +1,10 @@ +T11520.hs:15:57: error: + • Illegal type synonym family application ‘Any’ in instance: + Typeable (Compose f g) + Use -fprint-explicit-kinds to see the kind arguments + • In the instance declaration for ‘Typeable (Compose f g)’ + T11520.hs:15:77: error: • Expected kind ‘k20 -> k10’, but ‘g’ has kind ‘k’ • In the second argument of ‘Compose’, namely ‘g’ diff --git a/testsuite/tests/polykinds/T11523.hs b/testsuite/tests/polykinds/T11523.hs index 0313b0c46e..aff0f9ed90 100644 --- a/testsuite/tests/polykinds/T11523.hs +++ b/testsuite/tests/polykinds/T11523.hs @@ -15,7 +15,6 @@ {-# language FunctionalDependencies #-} {-# language UndecidableSuperClasses #-} {-# language UndecidableInstances #-} -{-# language TypeInType #-} module T11523 where diff --git a/testsuite/tests/polykinds/T11554.hs b/testsuite/tests/polykinds/T11554.hs index e7a35bd9d8..bca6b8277c 100644 --- a/testsuite/tests/polykinds/T11554.hs +++ b/testsuite/tests/polykinds/T11554.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE GADTs, TypeInType, RankNTypes #-} +{-# LANGUAGE GADTs, PolyKinds, RankNTypes #-} module T11554 where diff --git a/testsuite/tests/polykinds/T11616.hs b/testsuite/tests/polykinds/T11616.hs index 378032b7ed..16a62b33b2 100644 --- a/testsuite/tests/polykinds/T11616.hs +++ b/testsuite/tests/polykinds/T11616.hs @@ -1,6 +1,6 @@ {-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE TypeApplications #-} -{-# LANGUAGE TypeInType #-} +{-# LANGUAGE PolyKinds #-} module T11616 where class Whoami a where diff --git a/testsuite/tests/polykinds/T11640.hs b/testsuite/tests/polykinds/T11640.hs index 16d9f7ccff..ade4cbc79d 100644 --- a/testsuite/tests/polykinds/T11640.hs +++ b/testsuite/tests/polykinds/T11640.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE RankNTypes, TypeInType #-} +{-# LANGUAGE GADTs, RankNTypes, PolyKinds #-} module T11640 where diff --git a/testsuite/tests/polykinds/T11648.hs b/testsuite/tests/polykinds/T11648.hs index 15fcfa4e05..b8b70e8733 100644 --- a/testsuite/tests/polykinds/T11648.hs +++ b/testsuite/tests/polykinds/T11648.hs @@ -3,6 +3,8 @@ module T11648 where -class Monoidy (to :: k0 -> k1 -> *) (m :: k1) where +import Data.Kind + +class Monoidy (to :: k0 -> k1 -> Type) (m :: k1) where type MComp to m :: k1 -> k1 -> k0 mjoin :: MComp to m m m `to` m diff --git a/testsuite/tests/polykinds/T11648b.hs b/testsuite/tests/polykinds/T11648b.hs index 2ab27a6166..d50854d237 100644 --- a/testsuite/tests/polykinds/T11648b.hs +++ b/testsuite/tests/polykinds/T11648b.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE TypeInType #-} +{-# LANGUAGE DataKinds, PolyKinds #-} module T11648b where diff --git a/testsuite/tests/polykinds/T11648b.stderr b/testsuite/tests/polykinds/T11648b.stderr deleted file mode 100644 index e709e006b0..0000000000 --- a/testsuite/tests/polykinds/T11648b.stderr +++ /dev/null @@ -1,8 +0,0 @@ - -T11648b.hs:7:1: error: - You have written a *complete user-suppled kind signature*, - but the following variable is undetermined: k0 :: * - Perhaps add a kind signature. - Inferred kinds of user-written variables: - k :: k0 - a :: Proxy k diff --git a/testsuite/tests/polykinds/T11821a.hs b/testsuite/tests/polykinds/T11821a.hs index da96fe2c56..c5de2bbe53 100644 --- a/testsuite/tests/polykinds/T11821a.hs +++ b/testsuite/tests/polykinds/T11821a.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE GADTs, TypeInType, ConstraintKinds #-} +{-# LANGUAGE GADTs, DataKinds, PolyKinds, ConstraintKinds #-} module T11821a where import Data.Proxy type SameKind (a :: k1) (b :: k2) = ('Proxy :: Proxy k1) ~ ('Proxy :: Proxy k2) diff --git a/testsuite/tests/polykinds/T11821a.stderr b/testsuite/tests/polykinds/T11821a.stderr new file mode 100644 index 0000000000..2e443e637b --- /dev/null +++ b/testsuite/tests/polykinds/T11821a.stderr @@ -0,0 +1,4 @@ + +T11821a.hs:4:31: error: + • Couldn't match ‘k1’ with ‘k2’ + • In the type declaration for ‘SameKind’ diff --git a/testsuite/tests/polykinds/T12055.hs b/testsuite/tests/polykinds/T12055.hs index 3ffc221b7b..cabc2dfbba 100644 --- a/testsuite/tests/polykinds/T12055.hs +++ b/testsuite/tests/polykinds/T12055.hs @@ -3,9 +3,9 @@ {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE TypeInType #-} {-# LANGUAGE TypeOperators #-} -{-# LANGUAGE TypeInType #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE PolyKinds #-} -- The code from the ticket lacked these extensions, -- but crashed the compiler with "GHC internal error" diff --git a/testsuite/tests/polykinds/T12055a.hs b/testsuite/tests/polykinds/T12055a.hs index dab523861b..ebc4dc7cad 100644 --- a/testsuite/tests/polykinds/T12055a.hs +++ b/testsuite/tests/polykinds/T12055a.hs @@ -3,9 +3,9 @@ {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE TypeInType #-} {-# LANGUAGE TypeOperators #-} -{-# LANGUAGE TypeInType #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE PolyKinds #-} {-# LANGUAGE FlexibleInstances, UndecidableInstances, FunctionalDependencies #-} diff --git a/testsuite/tests/polykinds/T12593.hs b/testsuite/tests/polykinds/T12593.hs index 867fb89284..8fd4f26578 100644 --- a/testsuite/tests/polykinds/T12593.hs +++ b/testsuite/tests/polykinds/T12593.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE GADTs, ConstraintKinds, PolyKinds, TypeInType, KindSignatures, RankNTypes #-} +{-# LANGUAGE GADTs, ConstraintKinds, PolyKinds, KindSignatures, RankNTypes #-} module T12593 where diff --git a/testsuite/tests/polykinds/T12593.stderr b/testsuite/tests/polykinds/T12593.stderr index 4b551558a1..27123a8bc8 100644 --- a/testsuite/tests/polykinds/T12593.stderr +++ b/testsuite/tests/polykinds/T12593.stderr @@ -1,7 +1,6 @@ T12593.hs:11:16: error: - • Expecting two fewer arguments to ‘Free k k4 k5 p’ - Expected kind ‘k0 -> k1 -> *’, but ‘Free k k4 k5 p’ has kind ‘*’ + • Expected kind ‘k0 -> k1 -> *’, but ‘Free k k1 k2 p’ has kind ‘*’ • In the type signature: run :: k2 q => Free k k1 k2 p a b @@ -11,7 +10,7 @@ T12593.hs:12:31: error: • Expecting one more argument to ‘k’ Expected a type, but ‘k’ has kind - ‘(((k0 -> k1 -> *) -> Constraint) -> (k2 -> k3 -> *) -> *) + ‘(((k0 -> k1 -> *) -> Constraint) -> (k3 -> k4 -> *) -> *) -> Constraint’ • In the kind ‘k’ In the type signature: @@ -20,12 +19,98 @@ T12593.hs:12:31: error: -> (forall (c :: k) (d :: k1). p c d -> q c d) -> q a b T12593.hs:12:40: error: - • Expecting two more arguments to ‘k4’ + • Expecting two more arguments to ‘k1’ Expected a type, but - ‘k4’ has kind - ‘((k0 -> k1 -> *) -> Constraint) -> (k2 -> k3 -> *) -> *’ + ‘k1’ has kind + ‘((k0 -> k1 -> *) -> Constraint) -> (k3 -> k4 -> *) -> *’ • In the kind ‘k1’ In the type signature: run :: k2 q => Free k k1 k2 p a b -> (forall (c :: k) (d :: k1). p c d -> q c d) -> q a b + +T12593.hs:12:47: error: + • Couldn't match kind ‘(((k0 -> k1 -> *) -> Constraint) + -> (k3 -> k4 -> *) -> *) + -> Constraint’ + with ‘*’ + When matching kinds + k3 :: * + k6 :: (((k0 -> k1 -> *) -> Constraint) -> (k3 -> k4 -> *) -> *) + -> Constraint + • In the first argument of ‘p’, namely ‘c’ + In the type signature: + run :: k2 q => + Free k k1 k2 p a b + -> (forall (c :: k) (d :: k1). p c d -> q c d) -> q a b + +T12593.hs:12:49: error: + • Couldn't match kind ‘((k0 -> k1 -> *) -> Constraint) + -> (k3 -> k4 -> *) -> *’ + with ‘*’ + When matching kinds + k4 :: * + k7 :: ((k0 -> k1 -> *) -> Constraint) -> (k3 -> k4 -> *) -> * + • In the second argument of ‘p’, namely ‘d’ + In the type signature: + run :: k2 q => + Free k k1 k2 p a b + -> (forall (c :: k) (d :: k1). p c d -> q c d) -> q a b + +T12593.hs:12:56: error: + • Couldn't match kind ‘(((k0 -> k1 -> *) -> Constraint) + -> (k3 -> k4 -> *) -> *) + -> Constraint’ + with ‘*’ + When matching kinds + k0 :: * + k6 :: (((k0 -> k1 -> *) -> Constraint) -> (k3 -> k4 -> *) -> *) + -> Constraint + • In the first argument of ‘q’, namely ‘c’ + In the type signature: + run :: k2 q => + Free k k1 k2 p a b + -> (forall (c :: k) (d :: k1). p c d -> q c d) -> q a b + +T12593.hs:12:58: error: + • Couldn't match kind ‘((k0 -> k1 -> *) -> Constraint) + -> (k3 -> k4 -> *) -> *’ + with ‘*’ + When matching kinds + k1 :: * + k7 :: ((k0 -> k1 -> *) -> Constraint) -> (k3 -> k4 -> *) -> * + • In the second argument of ‘q’, namely ‘d’ + In the type signature: + run :: k2 q => + Free k k1 k2 p a b + -> (forall (c :: k) (d :: k1). p c d -> q c d) -> q a b + +T12593.hs:14:6: error: + • Couldn't match type ‘Free k2 p0’ with ‘Free k6 k7 k8 p’ + Expected type: Free k6 k7 k8 p a b + Actual type: Free k2 p0 a b + • In the pattern: Free cat + In an equation for ‘run’: run (Free cat) = cat + • Relevant bindings include + run :: Free k6 k7 k8 p a b + -> (forall (c :: k6) (d :: k7). p c d -> q c d) -> q a b + (bound at T12593.hs:14:1) + +T12593.hs:14:18: error: + • Couldn't match kind ‘*’ + with ‘(((k3 -> k4 -> *) -> Constraint) -> (k3 -> k4 -> *) -> *) + -> Constraint’ + When matching kinds + k0 :: * + k6 :: (((k0 -> k1 -> *) -> Constraint) -> (k3 -> k4 -> *) -> *) + -> Constraint + • In the expression: cat + In an equation for ‘run’: run (Free cat) = cat + • Relevant bindings include + cat :: forall (q :: k0 -> k1 -> *). + k2 q => + (forall (c :: k0) (d :: k1). p0 c d -> q c d) -> q a b + (bound at T12593.hs:14:11) + run :: Free k6 k7 k8 p a b + -> (forall (c :: k6) (d :: k7). p c d -> q c d) -> q a b + (bound at T12593.hs:14:1) diff --git a/testsuite/tests/polykinds/T12668.hs b/testsuite/tests/polykinds/T12668.hs index 4640903cc5..c3d2902a25 100644 --- a/testsuite/tests/polykinds/T12668.hs +++ b/testsuite/tests/polykinds/T12668.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE TypeInType #-} +{-# LANGUAGE PolyKinds #-} {-# LANGUAGE RankNTypes #-} module T12668 where diff --git a/testsuite/tests/polykinds/T12718.hs b/testsuite/tests/polykinds/T12718.hs index 82d6dcd177..7bbe1d572e 100644 --- a/testsuite/tests/polykinds/T12718.hs +++ b/testsuite/tests/polykinds/T12718.hs @@ -1,5 +1,5 @@ {-# Language RebindableSyntax, NoImplicitPrelude, MagicHash, RankNTypes, - PolyKinds, ViewPatterns, TypeInType, FlexibleInstances #-} + PolyKinds, ViewPatterns, FlexibleInstances #-} module Main where diff --git a/testsuite/tests/polykinds/T13391a.hs b/testsuite/tests/polykinds/T13391a.hs new file mode 100644 index 0000000000..4d5cc607c0 --- /dev/null +++ b/testsuite/tests/polykinds/T13391a.hs @@ -0,0 +1,7 @@ +{-# LANGUAGE GADTs #-} +module T13391a where + +-- this caused a panic during the work on T13391. + +data A a where + A3 :: b ~ Int => b -> A Int diff --git a/testsuite/tests/polykinds/T13393.stderr b/testsuite/tests/polykinds/T13393.stderr index 39ea640633..beea4732eb 100644 --- a/testsuite/tests/polykinds/T13393.stderr +++ b/testsuite/tests/polykinds/T13393.stderr @@ -8,7 +8,7 @@ T13393.hs:61:3: error: instance Traversable Identity -- Defined in ‘Data.Traversable’ instance Traversable Maybe -- Defined in ‘Data.Traversable’ ...plus two others - ...plus 24 instances involving out-of-scope types + ...plus 28 instances involving out-of-scope types (use -fprint-potential-instances to see them all) • In a stmt of a 'do' block: mapM putBackLeftOverInputAndReturnOutput undefined diff --git a/testsuite/tests/polykinds/T13555.stderr b/testsuite/tests/polykinds/T13555.stderr deleted file mode 100644 index eaea0335cf..0000000000 --- a/testsuite/tests/polykinds/T13555.stderr +++ /dev/null @@ -1,40 +0,0 @@ - -T13555.hs:25:14: error: - • Couldn't match type ‘k0’ with ‘k2’ - because type variable ‘k2’ would escape its scope - This (rigid, skolem) type variable is bound by - the type signature for: - crtInfo :: forall k2 (m :: k2). - Reflects m Int => - TaggedT m Maybe (CRTInfo (GF fp d)) - at T13555.hs:25:14-79 - Expected type: TaggedT m Maybe (CRTInfo (GF fp d)) - Actual type: TaggedT m Maybe (CRTInfo (GF fp d)) - • When checking that instance signature for ‘crtInfo’ - is more general than its signature in the class - Instance sig: forall (m :: k0). - Reflects m Int => - TaggedT m Maybe (CRTInfo (GF fp d)) - Class sig: forall k2 (m :: k2). - Reflects m Int => - TaggedT m Maybe (CRTInfo (GF fp d)) - In the instance declaration for ‘CRTrans Maybe (GF fp d)’ - -T13555.hs:25:14: error: - • Could not deduce (Reflects m Int) - from the context: Reflects m Int - bound by the type signature for: - crtInfo :: forall k2 (m :: k2). - Reflects m Int => - TaggedT m Maybe (CRTInfo (GF fp d)) - at T13555.hs:25:14-79 - The type variable ‘k0’ is ambiguous - • When checking that instance signature for ‘crtInfo’ - is more general than its signature in the class - Instance sig: forall (m :: k0). - Reflects m Int => - TaggedT m Maybe (CRTInfo (GF fp d)) - Class sig: forall k2 (m :: k2). - Reflects m Int => - TaggedT m Maybe (CRTInfo (GF fp d)) - In the instance declaration for ‘CRTrans Maybe (GF fp d)’ diff --git a/testsuite/tests/polykinds/T13625.hs b/testsuite/tests/polykinds/T13625.hs index 62d34611be..9367aa694f 100644 --- a/testsuite/tests/polykinds/T13625.hs +++ b/testsuite/tests/polykinds/T13625.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE TypeInType #-} +{-# LANGUAGE DataKinds, PolyKinds #-} module T13625 where diff --git a/testsuite/tests/polykinds/T13659.hs b/testsuite/tests/polykinds/T13659.hs index 199ff08a8d..118a04f122 100644 --- a/testsuite/tests/polykinds/T13659.hs +++ b/testsuite/tests/polykinds/T13659.hs @@ -4,8 +4,10 @@ module T13659 where +import Data.Kind (Type) + -- format string parameterized by a list of types -data Format (fmt :: [*]) where +data Format (fmt :: [Type]) where X :: Format '[] -- empty string, i.e. "" L :: a -> String -> Format '[] -- string literal, e.g. "hello" S :: a -> Format '[String] -- "%s" diff --git a/testsuite/tests/polykinds/T13659.stderr b/testsuite/tests/polykinds/T13659.stderr index fac5cbb952..84e81d04c0 100644 --- a/testsuite/tests/polykinds/T13659.stderr +++ b/testsuite/tests/polykinds/T13659.stderr @@ -1,5 +1,5 @@ -T13659.hs:12:27: error: +T13659.hs:14:27: error: • Expected a type, but ‘a’ has kind ‘[*]’ • In the first argument of ‘Format’, namely ‘'[Int, a]’ In the type ‘Format '[Int, a]’ diff --git a/testsuite/tests/polykinds/T13738.hs b/testsuite/tests/polykinds/T13738.hs new file mode 100644 index 0000000000..8420ca9158 --- /dev/null +++ b/testsuite/tests/polykinds/T13738.hs @@ -0,0 +1,14 @@ +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} + + +module T13738 where + +import Data.Coerce +import Data.Proxy + +foo x = coerce @(forall (a :: k). Proxy a -> Int) + @(forall (a :: k). Proxy a -> Int) + x diff --git a/testsuite/tests/polykinds/T13738.stderr b/testsuite/tests/polykinds/T13738.stderr new file mode 100644 index 0000000000..0bcce304ba --- /dev/null +++ b/testsuite/tests/polykinds/T13738.stderr @@ -0,0 +1,4 @@ + +T13738.hs:12:31: error: Not in scope: type variable ‘k’ + +T13738.hs:13:31: error: Not in scope: type variable ‘k’ diff --git a/testsuite/tests/polykinds/T13985.hs b/testsuite/tests/polykinds/T13985.hs new file mode 100644 index 0000000000..c0555d8f69 --- /dev/null +++ b/testsuite/tests/polykinds/T13985.hs @@ -0,0 +1,27 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE TypeFamilies #-} +module T13985 where + +import Data.Kind +import Data.Proxy + +data family Fam +data instance Fam = MkFam (forall (a :: k). Proxy a) + +type family T +type instance T = Proxy (Nothing :: Maybe a) + +class C k where + data CD :: k + type CT :: k + +instance C Type where + data CD = forall (a :: k). CD (Proxy a) + type CT = Proxy (Nothing :: Maybe a) + +class Z a where + type ZT a + type ZT a = Proxy (Nothing :: Maybe x) diff --git a/testsuite/tests/polykinds/T13985.stderr b/testsuite/tests/polykinds/T13985.stderr new file mode 100644 index 0000000000..f60314a443 --- /dev/null +++ b/testsuite/tests/polykinds/T13985.stderr @@ -0,0 +1,39 @@ + +T13985.hs:12:1: error: + • Kind variable ‘k’ is implicitly bound in data family + ‘Fam’, but does not appear as the kind of any + of its type variables. Perhaps you meant + to bind it explicitly somewhere? + • In the data instance declaration for ‘Fam’ + +T13985.hs:15:15: error: + • Kind variable ‘a’ is implicitly bound in type family + ‘T’, but does not appear as the kind of any + of its type variables. Perhaps you meant + to bind it explicitly somewhere? + • In the type instance declaration for ‘T’ + +T13985.hs:22:3: error: + • Kind variable ‘k’ is implicitly bound in associated data family + ‘CD’, but does not appear as the kind of any + of its type variables. Perhaps you meant + to bind it explicitly somewhere? + • In the data instance declaration for ‘CD’ + In the instance declaration for ‘C Type’ + +T13985.hs:23:8: error: + • Kind variable ‘a’ is implicitly bound in associated type family + ‘CT’, but does not appear as the kind of any + of its type variables. Perhaps you meant + to bind it explicitly somewhere? + • In the type instance declaration for ‘CT’ + In the instance declaration for ‘C Type’ + +T13985.hs:27:3: error: + • Kind variable ‘x’ is implicitly bound in associated type family + ‘ZT’, but does not appear as the kind of any + of its type variables. Perhaps you meant + to bind it explicitly somewhere? + Type variables with inferred kinds: (k :: *) (a :: k) + • In the default type instance declaration for ‘ZT’ + In the class declaration for ‘Z’ diff --git a/testsuite/tests/polykinds/T14110.hs b/testsuite/tests/polykinds/T14110.hs new file mode 100644 index 0000000000..d2e8e71896 --- /dev/null +++ b/testsuite/tests/polykinds/T14110.hs @@ -0,0 +1,9 @@ +{-# Language TypeFamilies, ScopedTypeVariables, PolyKinds, DataKinds #-} + +import Data.Kind + +class R (c :: k -> Constraint) where + type R_ (c :: k -> Constraint) :: k -> Type + +instance R Eq where + type R_ Eq a = a -> a -> Bool diff --git a/testsuite/tests/polykinds/T14110.stderr b/testsuite/tests/polykinds/T14110.stderr new file mode 100644 index 0000000000..aedfacb324 --- /dev/null +++ b/testsuite/tests/polykinds/T14110.stderr @@ -0,0 +1,5 @@ + +T14110.hs:9:8: error: + • Number of parameters must match family declaration; expected 1 + • In the type instance declaration for ‘R_’ + In the instance declaration for ‘R Eq’ diff --git a/testsuite/tests/polykinds/T14172.hs b/testsuite/tests/polykinds/T14172.hs new file mode 100644 index 0000000000..10fff5af69 --- /dev/null +++ b/testsuite/tests/polykinds/T14172.hs @@ -0,0 +1,7 @@ +module T14172 where + +import Data.Functor.Compose +import T14172a + +traverseCompose :: (a -> f b) -> g a -> f (h _) +traverseCompose = _Wrapping Compose . traverse diff --git a/testsuite/tests/polykinds/T14172.stderr b/testsuite/tests/polykinds/T14172.stderr new file mode 100644 index 0000000000..487b006ec1 --- /dev/null +++ b/testsuite/tests/polykinds/T14172.stderr @@ -0,0 +1,40 @@ + +T14172.hs:6:46: error: + • Found type wildcard ‘_’ standing for ‘a'’ + Where: ‘a'’ is a rigid type variable bound by + the inferred type of + traverseCompose :: (a -> f b) -> g a -> f (h a') + at T14172.hs:7:1-46 + To use the inferred type, enable PartialTypeSignatures + • In the type signature: + traverseCompose :: (a -> f b) -> g a -> f (h _) + +T14172.hs:7:19: error: + • Occurs check: cannot construct the infinite type: a ~ g'1 a + Expected type: (f'0 a -> f (f'0 b)) + -> Compose f'0 g'1 a -> f (h a') + Actual type: (Unwrapped (Compose f'0 g'1 a) + -> f (Unwrapped (h a'))) + -> Compose f'0 g'1 a -> f (h a') + • In the first argument of ‘(.)’, namely ‘_Wrapping Compose’ + In the expression: _Wrapping Compose . traverse + In an equation for ‘traverseCompose’: + traverseCompose = _Wrapping Compose . traverse + • Relevant bindings include + traverseCompose :: (a -> f b) -> g a -> f (h a') + (bound at T14172.hs:7:1) + +T14172.hs:7:19: error: + • Couldn't match type ‘g’ with ‘Compose f'0 g'1’ + ‘g’ is a rigid type variable bound by + the inferred type of + traverseCompose :: (a -> f b) -> g a -> f (h a') + at T14172.hs:7:1-46 + Expected type: (a -> f b) -> g a -> f (h a') + Actual type: (a -> f b) -> Compose f'0 g'1 a -> f (h a') + • In the expression: _Wrapping Compose . traverse + In an equation for ‘traverseCompose’: + traverseCompose = _Wrapping Compose . traverse + • Relevant bindings include + traverseCompose :: (a -> f b) -> g a -> f (h a') + (bound at T14172.hs:7:1) diff --git a/testsuite/tests/polykinds/T14172a.hs b/testsuite/tests/polykinds/T14172a.hs new file mode 100644 index 0000000000..b831372781 --- /dev/null +++ b/testsuite/tests/polykinds/T14172a.hs @@ -0,0 +1,67 @@ +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE UndecidableInstances #-} +module T14172a where + +import Data.Coerce +import Data.Functor.Compose +import Data.Functor.Identity + +class Profunctor p where + dimap :: (a -> b) -> (c -> d) -> p b c -> p a d + (#.) :: Coercible c b => (b -> c) -> p a b -> p a c + +instance Profunctor (->) where + dimap ab cd bc = cd . bc . ab + {-# INLINE dimap #-} + (#.) _ = coerce (\x -> x :: b) :: forall a b. Coercible b a => a -> b + {-# INLINE (#.) #-} + +type Iso s t a b = forall p f. (Profunctor p, Functor f) => p a (f b) -> p s (f t) +type Iso' s a = Iso s s a a + +iso :: (s -> a) -> (b -> t) -> Iso s t a b +iso sa bt = dimap sa (fmap bt) +{-# INLINE iso #-} + +type AnIso s t a b = Exchange a b a (Identity b) -> Exchange a b s (Identity t) + +data Exchange a b s t = Exchange (s -> a) (b -> t) + +instance Profunctor (Exchange a b) where + dimap f g (Exchange sa bt) = Exchange (sa . f) (g . bt) + {-# INLINE dimap #-} + (#.) _ = coerce + {-# INLINE ( #. ) #-} + +withIso :: AnIso s t a b -> ((s -> a) -> (b -> t) -> r) -> r +withIso ai k = case ai (Exchange id Identity) of + Exchange sa bt -> k sa (runIdentity #. bt) +{-# INLINE withIso #-} + +class Wrapped s where + type Unwrapped s :: * + _Wrapped' :: Iso' s (Unwrapped s) + +class Wrapped s => Rewrapped (s :: *) (t :: *) + +class (Rewrapped s t, Rewrapped t s) => Rewrapping s t +instance (Rewrapped s t, Rewrapped t s) => Rewrapping s t + +instance (t ~ Compose f' g' a') => Rewrapped (Compose f g a) t +instance Wrapped (Compose f g a) where + type Unwrapped (Compose f g a) = f (g a) + _Wrapped' = iso getCompose Compose + +_Wrapping :: Rewrapping s t => (Unwrapped s -> s) -> Iso s t (Unwrapped s) (Unwrapped t) +_Wrapping _ = _Wrapped +{-# INLINE _Wrapping #-} + +_Wrapped :: Rewrapping s t => Iso s t (Unwrapped s) (Unwrapped t) +_Wrapped = withIso _Wrapped' $ \ sa _ -> withIso _Wrapped' $ \ _ bt -> iso sa bt +{-# INLINE _Wrapped #-} diff --git a/testsuite/tests/polykinds/T14174.hs b/testsuite/tests/polykinds/T14174.hs new file mode 100644 index 0000000000..3fe4996225 --- /dev/null +++ b/testsuite/tests/polykinds/T14174.hs @@ -0,0 +1,6 @@ +{-# LANGUAGE RankNTypes, KindSignatures, PolyKinds #-} +module T14174 where + +data T k (x :: k) = MkT + +data S x = MkS (T (x Int) x) diff --git a/testsuite/tests/polykinds/T14174.stderr b/testsuite/tests/polykinds/T14174.stderr new file mode 100644 index 0000000000..4aafa647fd --- /dev/null +++ b/testsuite/tests/polykinds/T14174.stderr @@ -0,0 +1,7 @@ + +T14174.hs:6:27: error: + • Expecting one more argument to ‘x’ + Expected kind ‘x Int’, but ‘x’ has kind ‘* -> *’ + • In the second argument of ‘T’, namely ‘x’ + In the type ‘(T (x Int) x)’ + In the definition of data constructor ‘MkS’ diff --git a/testsuite/tests/polykinds/T14174a.hs b/testsuite/tests/polykinds/T14174a.hs new file mode 100644 index 0000000000..bdd3d7ee88 --- /dev/null +++ b/testsuite/tests/polykinds/T14174a.hs @@ -0,0 +1,57 @@ +{-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE UndecidableInstances #-} +module T14174a where + +import Data.Kind + +data TyFun :: Type -> Type -> Type +type a ~> b = TyFun a b -> Type +infixr 0 ~> + +type family Apply (f :: k1 ~> k2) (x :: k1) :: k2 +type a @@ b = Apply a b +infixl 9 @@ + +data FunArrow = (:->) | (:~>) + +class FunType (arr :: FunArrow) where + type Fun (k1 :: Type) arr (k2 :: Type) :: Type + +class FunType arr => AppType (arr :: FunArrow) where + type App k1 arr k2 (f :: Fun k1 arr k2) (x :: k1) :: k2 + +type FunApp arr = (FunType arr, AppType arr) + +instance FunType (:->) where + type Fun k1 (:->) k2 = k1 -> k2 + +instance AppType (:->) where + type App k1 (:->) k2 (f :: k1 -> k2) x = f x + +instance FunType (:~>) where + type Fun k1 (:~>) k2 = k1 ~> k2 + +instance AppType (:~>) where + type App k1 (:~>) k2 (f :: k1 ~> k2) x = f @@ x + +infixr 0 -?> +type (-?>) (k1 :: Type) (k2 :: Type) (arr :: FunArrow) = Fun k1 arr k2 + +type family ElimBool (p :: Bool -> Type) + (z :: Bool) + (pFalse :: p False) + (pTrue :: p True) + :: p z where + -- Commenting out the line below makes the panic go away + ElimBool p z pFalse pTrue = ElimBoolPoly (:->) p z pFalse pTrue + +type family ElimBoolPoly (arr :: FunArrow) + (p :: (Bool -?> Type) arr) + (z :: Bool) + (pFalse :: App Bool arr Type p False) + (pTrue :: App Bool arr Type p True) + :: App Bool arr Type p z diff --git a/testsuite/tests/polykinds/T14174a.stderr b/testsuite/tests/polykinds/T14174a.stderr new file mode 100644 index 0000000000..139597f9cb --- /dev/null +++ b/testsuite/tests/polykinds/T14174a.stderr @@ -0,0 +1,2 @@ + + diff --git a/testsuite/tests/polykinds/T14209.hs b/testsuite/tests/polykinds/T14209.hs new file mode 100644 index 0000000000..0f0648bd79 --- /dev/null +++ b/testsuite/tests/polykinds/T14209.hs @@ -0,0 +1,5 @@ +{-# LANGUAGE DataKinds, PolyKinds #-} +module T14209 where + +data MyProxy k (a :: k) = MyProxy +data Foo (z :: MyProxy k (a :: k)) diff --git a/testsuite/tests/polykinds/T14265.hs b/testsuite/tests/polykinds/T14265.hs new file mode 100644 index 0000000000..84c1a025a1 --- /dev/null +++ b/testsuite/tests/polykinds/T14265.hs @@ -0,0 +1,11 @@ +{-# LANGUAGE PolyKinds #-} + +module T124265 where + +import Control.Monad.Trans.State( StateT ) + +f :: proxy _ -> () +f _ = () + +foo :: StateT _ _ () +foo = undefined diff --git a/testsuite/tests/polykinds/T14265.stderr b/testsuite/tests/polykinds/T14265.stderr new file mode 100644 index 0000000000..be6868fdc4 --- /dev/null +++ b/testsuite/tests/polykinds/T14265.stderr @@ -0,0 +1,24 @@ + +T14265.hs:7:12: error: + • Found type wildcard ‘_’ standing for ‘w :: k’ + Where: ‘w’, ‘k’ are rigid type variables bound by + the inferred type of f :: proxy w -> () + at T14265.hs:8:1-8 + To use the inferred type, enable PartialTypeSignatures + • In the type signature: f :: proxy _ -> () + +T14265.hs:10:15: error: + • Found type wildcard ‘_’ standing for ‘w’ + Where: ‘w’ is a rigid type variable bound by + the inferred type of foo :: StateT w w1 () + at T14265.hs:11:1-15 + To use the inferred type, enable PartialTypeSignatures + • In the type signature: foo :: StateT _ _ () + +T14265.hs:10:17: error: + • Found type wildcard ‘_’ standing for ‘w1 :: * -> *’ + Where: ‘w1’ is a rigid type variable bound by + the inferred type of foo :: StateT w w1 () + at T14265.hs:11:1-15 + To use the inferred type, enable PartialTypeSignatures + • In the type signature: foo :: StateT _ _ () diff --git a/testsuite/tests/polykinds/T14270.hs b/testsuite/tests/polykinds/T14270.hs new file mode 100644 index 0000000000..3eed83c657 --- /dev/null +++ b/testsuite/tests/polykinds/T14270.hs @@ -0,0 +1,110 @@ +{-# LANGUAGE ViewPatterns #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE PatternSynonyms #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE PolyKinds #-} +module T14270 (pattern App) where + +import Data.Kind (Type) +import GHC.Fingerprint (Fingerprint, fingerprintFingerprints) +import GHC.Types (RuntimeRep, TYPE, TyCon) + +data (a :: k1) :~~: (b :: k2) where + HRefl :: a :~~: a + +data TypeRep (a :: k) where + TrTyCon :: {-# UNPACK #-} !Fingerprint -> !TyCon -> [SomeTypeRep] + -> TypeRep (a :: k) + + TrApp :: forall k1 k2 (a :: k1 -> k2) (b :: k1). + {-# UNPACK #-} !Fingerprint + -> TypeRep (a :: k1 -> k2) + -> TypeRep (b :: k1) + -> TypeRep (a b) + + TrFun :: forall (r1 :: RuntimeRep) (r2 :: RuntimeRep) + (a :: TYPE r1) (b :: TYPE r2). + {-# UNPACK #-} !Fingerprint + -> TypeRep a + -> TypeRep b + -> TypeRep (a -> b) + +data SomeTypeRep where + SomeTypeRep :: forall k (a :: k). !(TypeRep a) -> SomeTypeRep + +typeRepFingerprint :: TypeRep a -> Fingerprint +typeRepFingerprint = undefined + +mkTrApp :: forall k1 k2 (a :: k1 -> k2) (b :: k1). + TypeRep (a :: k1 -> k2) + -> TypeRep (b :: k1) + -> TypeRep (a b) +mkTrApp rep@(TrApp _ (TrTyCon _ con _) (x :: TypeRep x)) (y :: TypeRep y) + | con == funTyCon -- cheap check first + , Just (IsTYPE (rx :: TypeRep rx)) <- isTYPE (typeRepKind x) + , Just (IsTYPE (ry :: TypeRep ry)) <- isTYPE (typeRepKind y) + , Just HRefl <- withTypeable x $ withTypeable rx $ withTypeable ry + $ typeRep @((->) x :: TYPE ry -> Type) `eqTypeRep` rep + = undefined +mkTrApp a b = TrApp fpr a b + where + fpr_a = typeRepFingerprint a + fpr_b = typeRepFingerprint b + fpr = fingerprintFingerprints [fpr_a, fpr_b] + +pattern App :: forall k2 (t :: k2). () + => forall k1 (a :: k1 -> k2) (b :: k1). (t ~ a b) + => TypeRep a -> TypeRep b -> TypeRep t +pattern App f x <- (splitApp -> Just (IsApp f x)) + where App f x = mkTrApp f x + +data IsApp (a :: k) where + IsApp :: forall k k' (f :: k' -> k) (x :: k'). () + => TypeRep f -> TypeRep x -> IsApp (f x) + +splitApp :: forall k (a :: k). () + => TypeRep a + -> Maybe (IsApp a) +splitApp (TrApp _ f x) = Just (IsApp f x) +splitApp rep@(TrFun _ a b) = Just (IsApp (mkTrApp arr a) b) + where arr = bareArrow rep +splitApp (TrTyCon{}) = Nothing + +withTypeable :: forall a r. TypeRep a -> (Typeable a => r) -> r +withTypeable = undefined + +eqTypeRep :: forall k1 k2 (a :: k1) (b :: k2). + TypeRep a -> TypeRep b -> Maybe (a :~~: b) +eqTypeRep = undefined + +typeRepKind :: TypeRep (a :: k) -> TypeRep k +typeRepKind = undefined + +bareArrow :: forall (r1 :: RuntimeRep) (r2 :: RuntimeRep) + (a :: TYPE r1) (b :: TYPE r2). () + => TypeRep (a -> b) + -> TypeRep ((->) :: TYPE r1 -> TYPE r2 -> Type) +bareArrow = undefined + +data IsTYPE (a :: Type) where + IsTYPE :: forall (r :: RuntimeRep). TypeRep r -> IsTYPE (TYPE r) + +isTYPE :: TypeRep (a :: Type) -> Maybe (IsTYPE a) +isTYPE = undefined + +class Typeable (a :: k) where + +typeRep :: Typeable a => TypeRep a +typeRep = undefined + +funTyCon :: TyCon +funTyCon = undefined + +instance (Typeable f, Typeable a) => Typeable (f a) +instance Typeable ((->) :: TYPE r -> TYPE s -> Type) +instance Typeable TYPE diff --git a/testsuite/tests/polykinds/T14450.hs b/testsuite/tests/polykinds/T14450.hs new file mode 100644 index 0000000000..8571829619 --- /dev/null +++ b/testsuite/tests/polykinds/T14450.hs @@ -0,0 +1,33 @@ +{-# Language KindSignatures, TypeOperators, PolyKinds, TypeOperators, + ConstraintKinds, TypeFamilies, DataKinds, GADTs, + AllowAmbiguousTypes, InstanceSigs #-} + +module T14450 where + +import Data.Kind + +data TyFun :: Type -> Type -> Type + +type a ~> b = TyFun a b -> Type + +type Cat ob = ob -> ob -> Type + +type SameKind (a :: k) (b :: k) = (() :: Constraint) + +type family Apply (f :: a ~> b) (x :: a) :: b where + Apply IddSym0 x = Idd x + +class Varpi (f :: i ~> j) where + type Dom (f :: i ~> j) :: Cat i + type Cod (f :: i ~> j) :: Cat j + + varpa :: Dom f a a' -> Cod f (Apply f a) (Apply f a') + +type family Idd (a::k) :: k where + Idd (a::k) = a + +data IddSym0 :: k ~> k where + IddSym0KindInference :: IddSym0 l + +instance Varpi (IddSym0 :: k ~> k) where + type Dom (IddSym0 :: Type ~> Type) = (->) diff --git a/testsuite/tests/polykinds/T14450.stderr b/testsuite/tests/polykinds/T14450.stderr new file mode 100644 index 0000000000..e8ff4aeae3 --- /dev/null +++ b/testsuite/tests/polykinds/T14450.stderr @@ -0,0 +1,8 @@ + +T14450.hs:33:12: error: + • Expected kind ‘k ~> k’, + but ‘(IddSym0 :: Type ~> Type)’ has kind ‘* ~> *’ + • In the first argument of ‘Dom’, namely + ‘(IddSym0 :: Type ~> Type)’ + In the type instance declaration for ‘Dom’ + In the instance declaration for ‘Varpi (IddSym0 :: k ~> k)’ diff --git a/testsuite/tests/polykinds/T14515.hs b/testsuite/tests/polykinds/T14515.hs new file mode 100644 index 0000000000..4a2540b925 --- /dev/null +++ b/testsuite/tests/polykinds/T14515.hs @@ -0,0 +1,14 @@ +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE PolyKinds #-} +module Bug where + +import Data.Kind + +type HRank1 ty = forall k1. k1 -> ty +type HRank2 ty = forall k2. k2 -> ty + +data HREFL11 :: HRank1 (HRank1 Type) -- FAILS +data HREFL12 :: HRank1 (HRank2 Type) +data HREFL21 :: HRank2 (HRank1 Type) +data HREFL22 :: HRank2 (HRank2 Type) -- FAILS diff --git a/testsuite/tests/polykinds/T14520.hs b/testsuite/tests/polykinds/T14520.hs new file mode 100644 index 0000000000..44dc2ee18d --- /dev/null +++ b/testsuite/tests/polykinds/T14520.hs @@ -0,0 +1,16 @@ +{-# Language DataKinds, PolyKinds, TypeFamilies, TypeOperators, AllowAmbiguousTypes #-} + +module T14520 where + +import Data.Kind + +type a ~>> b = (a, b) -> Type + +data family Sing (a::k) + +type family XXX (f::a~>>b) (x::a) :: b + +type family Id :: (kat :: a ~>> (a ~>> Type)) `XXX` (b :: a) `XXX` b + +sId :: Sing w -> Sing (Id :: bat w w) +sId = sId diff --git a/testsuite/tests/polykinds/T14520.stderr b/testsuite/tests/polykinds/T14520.stderr new file mode 100644 index 0000000000..9c290ff4a5 --- /dev/null +++ b/testsuite/tests/polykinds/T14520.stderr @@ -0,0 +1,6 @@ + +T14520.hs:15:24: error: + • Expected kind ‘bat w w’, + but ‘Id’ has kind ‘XXX a0 * (XXX a0 (a0 ~>> *) kat0 b0) b0’ + • In the first argument of ‘Sing’, namely ‘(Id :: bat w w)’ + In the type signature: sId :: Sing w -> Sing (Id :: bat w w) diff --git a/testsuite/tests/polykinds/T14555.hs b/testsuite/tests/polykinds/T14555.hs new file mode 100644 index 0000000000..7f37a5ec9c --- /dev/null +++ b/testsuite/tests/polykinds/T14555.hs @@ -0,0 +1,12 @@ +{-# Language TypeOperators, DataKinds, PolyKinds, GADTs #-} + + +module T14555 where + +import Data.Kind +import GHC.Types (TYPE, Type) + +data Exp :: [TYPE rep] -> TYPE rep -> Type where +--data Exp (x :: [TYPE rep]) (y :: TYPE rep) where +--data Exp (x :: [TYPE rep]) y where + Lam :: Exp (a:xs) b -> Exp xs (a -> b) diff --git a/testsuite/tests/polykinds/T14555.stderr b/testsuite/tests/polykinds/T14555.stderr new file mode 100644 index 0000000000..66fb55ae4f --- /dev/null +++ b/testsuite/tests/polykinds/T14555.stderr @@ -0,0 +1,6 @@ + +T14555.hs:12:34: error: + • Expected kind ‘TYPE rep’, but ‘a -> b’ has kind ‘*’ + • In the second argument of ‘Exp’, namely ‘(a -> b)’ + In the type ‘Exp xs (a -> b)’ + In the definition of data constructor ‘Lam’ diff --git a/testsuite/tests/polykinds/T14561.hs b/testsuite/tests/polykinds/T14561.hs new file mode 100644 index 0000000000..7b1f17e08e --- /dev/null +++ b/testsuite/tests/polykinds/T14561.hs @@ -0,0 +1,18 @@ +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE MagicHash #-} + +module T14561 where + +import GHC.Types +import GHC.Prim + +badId :: forall (a :: TYPE r). a -> a +badId = unsafeCoerce# +-- Un-saturated application of a levity-polymorphic +-- function that must be eta-expanded + +goodId :: forall (a :: Type). a -> a +goodId = unsafeCoerce# +-- But this one is OK diff --git a/testsuite/tests/polykinds/T14561.stderr b/testsuite/tests/polykinds/T14561.stderr new file mode 100644 index 0000000000..d39dec4d7b --- /dev/null +++ b/testsuite/tests/polykinds/T14561.stderr @@ -0,0 +1,5 @@ + +T14561.hs:12:9: error: + Cannot use primitive with levity-polymorphic arguments: + unsafeCoerce# :: a -> a + Levity-polymorphic arguments: a :: TYPE r diff --git a/testsuite/tests/polykinds/T14563.hs b/testsuite/tests/polykinds/T14563.hs new file mode 100644 index 0000000000..bdc05dd6df --- /dev/null +++ b/testsuite/tests/polykinds/T14563.hs @@ -0,0 +1,9 @@ +{-# Language RankNTypes, KindSignatures, PolyKinds #-} +{-# OPTIONS_GHC -fprint-explicit-runtime-reps #-} + +import GHC.Types (TYPE) +import Data.Kind + +data Lan (g::TYPE rep -> TYPE rep') (h::TYPE rep -> TYPE rep'') a where + Lan :: forall xx (g::TYPE rep -> TYPE rep') (h::TYPE rep -> Type) a. + (g xx -> a) -> h xx -> Lan g h a diff --git a/testsuite/tests/polykinds/T14563.stderr b/testsuite/tests/polykinds/T14563.stderr new file mode 100644 index 0000000000..1265ec0e3a --- /dev/null +++ b/testsuite/tests/polykinds/T14563.stderr @@ -0,0 +1,7 @@ + +T14563.hs:9:39: error: + • Expected kind ‘TYPE rep -> TYPE rep''’, + but ‘h’ has kind ‘TYPE rep -> *’ + • In the second argument of ‘Lan’, namely ‘h’ + In the type ‘Lan g h a’ + In the definition of data constructor ‘Lan’ diff --git a/testsuite/tests/polykinds/T14580.hs b/testsuite/tests/polykinds/T14580.hs new file mode 100644 index 0000000000..58983cc117 --- /dev/null +++ b/testsuite/tests/polykinds/T14580.hs @@ -0,0 +1,8 @@ +{-# LANGUAGE PolyKinds, DataKinds, TypeOperators #-} +module T14580 where +import Data.Kind + +type Cat ob = ob -> ob -> Type +data ISO' :: Cat i -> i -> i -> Type +type ISO cat a b = ISO' cat a b -> Type +type (a <--> b) iso cat = ISO (iso :: cat a b) diff --git a/testsuite/tests/polykinds/T14580.stderr b/testsuite/tests/polykinds/T14580.stderr new file mode 100644 index 0000000000..babbb49cf8 --- /dev/null +++ b/testsuite/tests/polykinds/T14580.stderr @@ -0,0 +1,6 @@ + +T14580.hs:8:31: error: + • Expected kind ‘Cat a’, but ‘(iso :: cat a b)’ has kind ‘cat a b’ + • In the first argument of ‘ISO’, namely ‘(iso :: cat a b)’ + In the type ‘ISO (iso :: cat a b)’ + In the type declaration for ‘<-->’ diff --git a/testsuite/tests/polykinds/T14710.hs b/testsuite/tests/polykinds/T14710.hs new file mode 100644 index 0000000000..2fec10a7a1 --- /dev/null +++ b/testsuite/tests/polykinds/T14710.hs @@ -0,0 +1,25 @@ +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE ScopedTypeVariables #-} +module T14710 where + +import Data.Proxy + +class C a b where + c1 :: Proxy (x :: a) -> b + c2 :: forall (x :: a). Proxy x -> b + +f :: forall a. a -> a +f x = const x (const g1 g2) + where + g1 :: Proxy (x :: a) + g1 = Proxy + + g2 :: forall (x :: a). Proxy x + g2 = Proxy + +h1 :: forall k a. Proxy (a :: k) +h1 = Proxy + +h2 :: forall k (a :: k). Proxy a +h2 = Proxy diff --git a/testsuite/tests/polykinds/T14710.stderr b/testsuite/tests/polykinds/T14710.stderr new file mode 100644 index 0000000000..0bbfb0d641 --- /dev/null +++ b/testsuite/tests/polykinds/T14710.stderr @@ -0,0 +1,30 @@ + +T14710.hs:9:21: error: + Unexpected kind variable ‘a’ + Perhaps you intended to use PolyKinds + In a class method signature for ‘c1’ + +T14710.hs:10:22: error: + Unexpected kind variable ‘a’ + Perhaps you intended to use PolyKinds + In a class method signature for ‘c2’ + +T14710.hs:15:23: error: + Unexpected kind variable ‘a’ + Perhaps you intended to use PolyKinds + In the type signature for ‘g1’ + +T14710.hs:18:24: error: + Unexpected kind variable ‘a’ + Perhaps you intended to use PolyKinds + In the type signature for ‘g2’ + +T14710.hs:21:31: error: + Unexpected kind variable ‘k’ + Perhaps you intended to use PolyKinds + In the type signature for ‘h1’ + +T14710.hs:24:22: error: + Unexpected kind variable ‘k’ + Perhaps you intended to use PolyKinds + In the type signature for ‘h2’ diff --git a/testsuite/tests/polykinds/T14723.hs b/testsuite/tests/polykinds/T14723.hs new file mode 100644 index 0000000000..9b2f3bf75e --- /dev/null +++ b/testsuite/tests/polykinds/T14723.hs @@ -0,0 +1,70 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FunctionalDependencies #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE UndecidableInstances #-} + +module T14723 () where + +import Data.Coerce( coerce ) +import Data.Kind (Type) +import Data.Proxy (Proxy(..)) +import Data.String (fromString) +import Data.Int (Int64) +import GHC.Stack (HasCallStack) +import GHC.TypeLits (Nat, Symbol) + +data JType = Iface Symbol + +data J (a :: JType) + +newIterator + :: IO (J ('Iface "java.util.Iterator")) +newIterator = do + let tblPtr :: Int64 + tblPtr = undefined + iterator <- + (qqMarker (Proxy :: Proxy "wuggle") + (Proxy :: Proxy "waggle") + (Proxy :: Proxy "tblPtr") + (Proxy :: Proxy 106) + (tblPtr, ()) + Proxy + (undefined :: IO Int)) + undefined + +class Coercible (a :: Type) where + type Ty a :: JType + +instance Coercible Int64 where + type Ty Int64 = Iface "Int64" +instance Coercible Int where + type Ty Int = Iface "Int" + +class Coercibles xs (tys :: k) | xs -> tys +instance Coercibles () () +instance (ty ~ Ty x, Coercible x, Coercibles xs tys) => Coercibles (x, xs) '(ty, tys) + +qqMarker + :: forall + -- k -- the kind variable shows up in Core + (args_tys :: k) -- JType's of arguments + tyres -- JType of result + (input :: Symbol) -- input string of the quasiquoter + (mname :: Symbol) -- name of the method to generate + (antiqs :: Symbol) -- antiquoted variables as a comma-separated list + (line :: Nat) -- line number of the quasiquotation + args_tuple -- uncoerced argument types + b. -- uncoerced result type + (tyres ~ Ty b, Coercibles args_tuple args_tys, Coercible b, HasCallStack) + => Proxy input + -> Proxy mname + -> Proxy antiqs + -> Proxy line + -> args_tuple + -> Proxy args_tys + -> IO b + -> IO b +qqMarker = undefined diff --git a/testsuite/tests/polykinds/T14846.hs b/testsuite/tests/polykinds/T14846.hs new file mode 100644 index 0000000000..0f70962562 --- /dev/null +++ b/testsuite/tests/polykinds/T14846.hs @@ -0,0 +1,39 @@ +{-# LANGUAGE AllowAmbiguousTypes #-} +{-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE EmptyCase #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE InstanceSigs #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE DataKinds, PolyKinds #-} +module T14846 where + +import Data.Kind +import Data.Proxy + +type Cat ob = ob -> ob -> Type + +data Struct :: (k -> Constraint) -> Type where + S :: Proxy (a::k) -> Struct (cls::k -> Constraint) + +type Structured a cls = (S ('Proxy :: Proxy a)::Struct cls) + +data AStruct :: Struct cls -> Type where + AStruct :: cls a => AStruct (Structured a cls) + +class StructI xx (structured::Struct (cls :: k -> Constraint)) where + struct :: AStruct structured + +instance (Structured xx cls ~ structured, cls xx) => StructI xx structured where + struct :: AStruct (Structured xx cls) + struct = AStruct + +data Hom :: Cat k -> Cat (Struct cls) where + +class Category (cat::Cat ob) where + i :: StructI xx a => ríki a a + +instance Category riki => Category (Hom riki :: Cat (Struct cls)) where + i :: forall xx a. StructI xx a => Hom riki a a + i = case struct :: AStruct (Structured a cls) of diff --git a/testsuite/tests/polykinds/T14846.stderr b/testsuite/tests/polykinds/T14846.stderr new file mode 100644 index 0000000000..1d852031d9 --- /dev/null +++ b/testsuite/tests/polykinds/T14846.stderr @@ -0,0 +1,48 @@ + +T14846.hs:38:8: error: + • Couldn't match type ‘ríki’ with ‘Hom riki’ + ‘ríki’ is a rigid type variable bound by + the type signature for: + i :: forall k5 (cls2 :: k5 + -> Constraint) k6 (xx :: k6) (a :: Struct cls2) (ríki :: Struct + cls2 + -> Struct + cls2 + -> *). + StructI xx a => + ríki a a + at T14846.hs:38:8-48 + Expected type: ríki a a + Actual type: Hom riki a a + • When checking that instance signature for ‘i’ + is more general than its signature in the class + Instance sig: forall k1 (cls :: k1 + -> Constraint) k2 (xx :: k2) (a :: Struct cls). + StructI xx a => + Hom riki a a + Class sig: forall k1 (cls :: k1 + -> Constraint) k2 (xx :: k2) (a :: Struct + cls) (ríki :: Struct + cls + -> Struct + cls + -> *). + StructI xx a => + ríki a a + In the instance declaration for ‘Category (Hom riki)’ + +T14846.hs:39:31: error: + • Couldn't match kind ‘k4’ with ‘Struct cls2’ + ‘k4’ is a rigid type variable bound by + the instance declaration + at T14846.hs:37:10-65 + When matching kinds + cls1 :: k4 -> Constraint + cls0 :: Struct cls -> Constraint + Expected kind ‘Struct cls0’, + but ‘Structured a cls’ has kind ‘Struct cls1’ + • In the first argument of ‘AStruct’, namely ‘(Structured a cls)’ + In an expression type signature: AStruct (Structured a cls) + In the expression: struct :: AStruct (Structured a cls) + • Relevant bindings include + i :: Hom riki a a (bound at T14846.hs:39:3) diff --git a/testsuite/tests/polykinds/T14873.hs b/testsuite/tests/polykinds/T14873.hs new file mode 100644 index 0000000000..9450a019bc --- /dev/null +++ b/testsuite/tests/polykinds/T14873.hs @@ -0,0 +1,50 @@ +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE PolyKinds #-} +module T14873 where + +import Data.Kind (Type) + +data family Sing (a :: k) + +newtype instance Sing (f :: k1 ~> k2) = + SLambda { applySing :: forall t. Sing t -> Sing (Apply f t) } + +data TyFun :: Type -> Type -> Type +type a ~> b = TyFun a b -> Type +infixr 0 ~> +type family Apply (f :: k1 ~> k2) (x :: k1) :: k2 + +class SingI (a :: k) where + sing :: Sing a + +data ColSym1 :: f a -> a ~> Bool +type instance Apply (ColSym1 x) y = Col x y + +class PColumn (f :: Type -> Type) where + type Col (x :: f a) (y :: a) :: Bool + +class SColumn (f :: Type -> Type) where + sCol :: forall (x :: f a) (y :: a). + Sing x -> Sing y -> Sing (Col x y :: Bool) + +instance (SColumn f, SingI x) => SingI (ColSym1 (x :: f a) :: a ~> Bool) where + sing = SLambda (sCol (sing @_ @x)) + +{- When the bug was present, this smaller kind-incorrect version also + elicited the same piResultTy crash + + But it's kind-incorrect, whereas the main test case should compile file + +class SingI (a :: k) where + +class SColumn (f :: Type -> Type) where + +instance -- forall (f :: Type -> Type) a (x :: f a). + SColumn f => SingI (x :: f a) +-} + diff --git a/testsuite/tests/polykinds/T14939.hs b/testsuite/tests/polykinds/T14939.hs new file mode 100644 index 0000000000..eb3c700f9f --- /dev/null +++ b/testsuite/tests/polykinds/T14939.hs @@ -0,0 +1,19 @@ +{-# Language RankNTypes, ConstraintKinds, TypeInType, GADTs #-} + +module T14939 where + +import Data.Kind + +type Cat ob = ob -> ob -> Type + +type Alg cls ob = ob + +newtype Frí (cls::Type -> Constraint) :: (Type -> Alg cls Type) where + Frí :: { with :: forall x. cls x => (a -> x) -> x } + -> Frí cls a + +data AlgCat (cls::Type -> Constraint) :: Cat (Alg cls Type) where + AlgCat :: (cls a, cls b) => (a -> b) -> AlgCat cls a b + +leftAdj :: AlgCat cls (Frí cls a) b -> (a -> b) +leftAdj (AlgCat f) a = undefined
\ No newline at end of file diff --git a/testsuite/tests/polykinds/T15116.hs b/testsuite/tests/polykinds/T15116.hs new file mode 100644 index 0000000000..7089b52383 --- /dev/null +++ b/testsuite/tests/polykinds/T15116.hs @@ -0,0 +1,9 @@ +{-# LANGUAGE GADTs, PolyKinds, DataKinds #-} +module T15116 where + +import Data.Proxy + +data A (a :: k) where + MkA :: A MkA + + diff --git a/testsuite/tests/polykinds/T15116.stderr b/testsuite/tests/polykinds/T15116.stderr new file mode 100644 index 0000000000..bcbf89f8dc --- /dev/null +++ b/testsuite/tests/polykinds/T15116.stderr @@ -0,0 +1,7 @@ + +T15116.hs:7:12: error: + • Data constructor ‘MkA’ cannot be used here + (it is defined and used in the same recursive group) + • In the first argument of ‘A’, namely ‘MkA’ + In the type ‘A MkA’ + In the definition of data constructor ‘MkA’ diff --git a/testsuite/tests/polykinds/T15116a.hs b/testsuite/tests/polykinds/T15116a.hs new file mode 100644 index 0000000000..8f69e4d87a --- /dev/null +++ b/testsuite/tests/polykinds/T15116a.hs @@ -0,0 +1,6 @@ +{-# LANGUAGE PolyKinds, DataKinds #-} +module T15116a where + +import Data.Proxy + +data B = MkB (Proxy 'MkB) diff --git a/testsuite/tests/polykinds/T15116a.stderr b/testsuite/tests/polykinds/T15116a.stderr new file mode 100644 index 0000000000..7e4788f5b8 --- /dev/null +++ b/testsuite/tests/polykinds/T15116a.stderr @@ -0,0 +1,7 @@ + +T15116a.hs:6:21: error: + • Data constructor ‘MkB’ cannot be used here + (it is defined and used in the same recursive group) + • In the first argument of ‘Proxy’, namely ‘ 'MkB’ + In the type ‘(Proxy 'MkB)’ + In the definition of data constructor ‘MkB’ diff --git a/testsuite/tests/polykinds/T15170.hs b/testsuite/tests/polykinds/T15170.hs new file mode 100644 index 0000000000..02de90ae12 --- /dev/null +++ b/testsuite/tests/polykinds/T15170.hs @@ -0,0 +1,26 @@ +{-# LANGUAGE AllowAmbiguousTypes #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE DataKinds, PolyKinds #-} +{-# LANGUAGE TypeOperators #-} +module T15170 where + +import Data.Kind +import Data.Proxy + +data TyFun :: Type -> Type -> Type +type a ~> b = TyFun a b -> Type +infixr 0 ~> + +type family Apply (f :: k1 ~> k2) (x :: k1) :: k2 +type f @@ x = Apply f x +infixl 9 @@ + +wat :: forall (a :: Type) + (b :: a ~> Type) + (c :: forall (x :: a). Proxy x ~> b @@ x ~> Type) + (f :: forall (x :: a) (y :: b @@ x). Proxy x ~> Proxy y ~> c @@ ('Proxy :: Proxy x) @@ y) + (x :: a). + (forall (xx :: a) (yy :: b @@ xx). Proxy (f @@ ('Proxy :: Proxy xx) @@ ('Proxy :: Proxy yy))) + -> () +wat _ = () diff --git a/testsuite/tests/polykinds/T15577.hs b/testsuite/tests/polykinds/T15577.hs new file mode 100644 index 0000000000..18ebc42f92 --- /dev/null +++ b/testsuite/tests/polykinds/T15577.hs @@ -0,0 +1,21 @@ +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeInType #-} +{-# LANGUAGE TypeOperators #-} +module Bug where + +import Data.Kind +import Data.Proxy +import Data.Type.Equality + +type family F (x :: f (a :: k)) :: f a + +f :: forall k (f :: k -> Type) (a :: k) (r :: f a). Proxy r -> F r :~: r +f = undefined + +g :: forall (f :: Type -> Type) (a :: Type) (r :: f a). Proxy r -> F r :~: r +g r | Refl <- f -- Uncommenting the line below makes it work again + -- @Type + @f @a @r r + = Refl diff --git a/testsuite/tests/polykinds/T15577.stderr b/testsuite/tests/polykinds/T15577.stderr new file mode 100644 index 0000000000..fef17090f8 --- /dev/null +++ b/testsuite/tests/polykinds/T15577.stderr @@ -0,0 +1,71 @@ + +T15577.hs:20:18: error: + • Expecting one more argument to ‘f’ + Expected a type, but ‘f’ has kind ‘* -> *’ + • In the type ‘f’ + In a stmt of a pattern guard for + an equation for ‘g’: + Refl <- f @f @a @r r + In an equation for ‘g’: g r | Refl <- f @f @a @r r = Refl + +T15577.hs:20:21: error: + • Expected kind ‘f1 -> *’, but ‘a’ has kind ‘*’ + • In the type ‘a’ + In a stmt of a pattern guard for + an equation for ‘g’: + Refl <- f @f @a @r r + In an equation for ‘g’: g r | Refl <- f @f @a @r r = Refl + • Relevant bindings include + r :: Proxy r1 (bound at T15577.hs:18:3) + g :: Proxy r1 -> F r1 :~: r1 (bound at T15577.hs:18:1) + +T15577.hs:20:24: error: + • Couldn't match kind ‘* -> *’ with ‘*’ + When matching kinds + f1 :: * -> * + f1 a1 :: * + Expected kind ‘f1’, but ‘r’ has kind ‘f1 a1’ + • In the type ‘r’ + In a stmt of a pattern guard for + an equation for ‘g’: + Refl <- f @f @a @r r + In an equation for ‘g’: g r | Refl <- f @f @a @r r = Refl + • Relevant bindings include + r :: Proxy r1 (bound at T15577.hs:18:3) + g :: Proxy r1 -> F r1 :~: r1 (bound at T15577.hs:18:1) + +T15577.hs:20:26: error: + • Couldn't match kind ‘* -> *’ with ‘*’ + When matching kinds + f1 :: * -> * + a1 :: * + • In the fourth argument of ‘f’, namely ‘r’ + In a stmt of a pattern guard for + an equation for ‘g’: + Refl <- f @f @a @r r + In an equation for ‘g’: g r | Refl <- f @f @a @r r = Refl + • Relevant bindings include + r :: Proxy r1 (bound at T15577.hs:18:3) + g :: Proxy r1 -> F r1 :~: r1 (bound at T15577.hs:18:1) + +T15577.hs:21:7: error: + • Could not deduce: F r1 ~ r1 + from the context: r0 ~ F r0 + bound by a pattern with constructor: + Refl :: forall k (a :: k). a :~: a, + in a pattern binding in + a pattern guard for + an equation for ‘g’ + at T15577.hs:18:7-10 + ‘r1’ is a rigid type variable bound by + the type signature for: + g :: forall (f1 :: * -> *) a1 (r1 :: f1 a1). + Proxy r1 -> F r1 :~: r1 + at T15577.hs:17:1-76 + Expected type: F r1 :~: r1 + Actual type: r1 :~: r1 + • In the expression: Refl + In an equation for ‘g’: g r | Refl <- f @f @a @r r = Refl + • Relevant bindings include + r :: Proxy r1 (bound at T15577.hs:18:3) + g :: Proxy r1 -> F r1 :~: r1 (bound at T15577.hs:18:1) diff --git a/testsuite/tests/polykinds/T5716.hs b/testsuite/tests/polykinds/T5716.hs index 1b705a36b1..217e4c399a 100644 --- a/testsuite/tests/polykinds/T5716.hs +++ b/testsuite/tests/polykinds/T5716.hs @@ -4,10 +4,11 @@ module T5716 where +import Data.Kind (Type) data family DF a data instance DF Int = DFInt data U = U1 (DF Int) -data I :: U -> * where I1 :: I (U1 DFInt) +data I :: U -> Type where I1 :: I (U1 DFInt) diff --git a/testsuite/tests/polykinds/T5716.stderr b/testsuite/tests/polykinds/T5716.stderr index d85166b0bb..41bf517339 100644 --- a/testsuite/tests/polykinds/T5716.stderr +++ b/testsuite/tests/polykinds/T5716.stderr @@ -1,7 +1,7 @@ -T5716.hs:13:33: error: - Data constructor ‘U1’ cannot be used here - (Perhaps you intended to use TypeInType) - In the first argument of ‘I’, namely ‘(U1 DFInt)’ - In the type ‘I (U1 DFInt)’ - In the definition of data constructor ‘I1’ +T5716.hs:14:39: error: + • Data constructor ‘DFInt’ cannot be used here + (it comes from a data family instance) + • In the first argument of ‘U1’, namely ‘DFInt’ + In the first argument of ‘I’, namely ‘(U1 DFInt)’ + In the type ‘I (U1 DFInt)’ diff --git a/testsuite/tests/polykinds/T6021.stderr b/testsuite/tests/polykinds/T6021.stderr deleted file mode 100644 index d747043d27..0000000000 --- a/testsuite/tests/polykinds/T6021.stderr +++ /dev/null @@ -1,4 +0,0 @@ - -T6021.hs:5:22: error: - Variable ‘b’ used as both a kind and a type - Did you intend to use TypeInType? diff --git a/testsuite/tests/polykinds/T6035.hs b/testsuite/tests/polykinds/T6035.hs index a6f5ffe54a..c89de8e73d 100644 --- a/testsuite/tests/polykinds/T6035.hs +++ b/testsuite/tests/polykinds/T6035.hs @@ -3,9 +3,11 @@ module T6035 where +import Data.Kind (Type) + data Nat = Zero | Succ Nat -type family Sing (a :: k) :: k -> * +type family Sing (a :: k) :: k -> Type data SNat n where SZero :: SNat Zero diff --git a/testsuite/tests/polykinds/T6039.stderr b/testsuite/tests/polykinds/T6039.stderr deleted file mode 100644 index 4c31bb4aa4..0000000000 --- a/testsuite/tests/polykinds/T6039.stderr +++ /dev/null @@ -1,5 +0,0 @@ - -T6039.hs:5:14: error: - • Expecting one fewer arguments to ‘j’ - Expected kind ‘* -> *’, but ‘j’ has kind ‘*’ - • In the kind ‘j k’ diff --git a/testsuite/tests/polykinds/T6093.hs b/testsuite/tests/polykinds/T6093.hs index 3fdeb207f8..1063b8661d 100644 --- a/testsuite/tests/polykinds/T6093.hs +++ b/testsuite/tests/polykinds/T6093.hs @@ -1,13 +1,12 @@ -{-# LANGUAGE GADTs, PolyKinds #-} +{-# LANGUAGE GADTs, RankNTypes, PolyKinds #-} module T6093 where -- Polymorphic kind recursion -data R :: k -> * where +data R :: forall k. k -> * where MkR :: R f -> R (f ()) - data IOWitness (a :: k) = IOW -data Type :: k -> * where +data Type :: forall k. k -> * where SimpleType :: IOWitness a -> Type a ConstructedType :: Type f -> Type a -> Type (f a) diff --git a/testsuite/tests/polykinds/T7224.stderr b/testsuite/tests/polykinds/T7224.stderr index daab1c40a9..774a4bce69 100644 --- a/testsuite/tests/polykinds/T7224.stderr +++ b/testsuite/tests/polykinds/T7224.stderr @@ -2,6 +2,12 @@ T7224.hs:6:19: error: • Expected kind ‘i’, but ‘i’ has kind ‘*’ • In the first argument of ‘m’, namely ‘i’ + In the type signature: ret' :: a -> m i i a + In the class declaration for ‘PMonad'’ + +T7224.hs:7:14: error: + • Expected kind ‘i’, but ‘i’ has kind ‘*’ + • In the first argument of ‘m’, namely ‘i’ In the type signature: - ret' :: a -> m i i a + bind' :: m i j a -> (a -> m j k b) -> m i k b In the class declaration for ‘PMonad'’ diff --git a/testsuite/tests/polykinds/T7278.stderr b/testsuite/tests/polykinds/T7278.stderr index 676be2cb0f..265e27892b 100644 --- a/testsuite/tests/polykinds/T7278.stderr +++ b/testsuite/tests/polykinds/T7278.stderr @@ -1,6 +1,5 @@ T7278.hs:9:43: error: - • Expecting two fewer arguments to ‘t’ - Expected kind ‘* -> * -> *’, but ‘t’ has kind ‘k’ + • Expected kind ‘* -> * -> *’, but ‘t’ has kind ‘k’ • In the type signature: f :: (C (t :: k) (TF t)) => TF t p1 p0 -> t p1 p0 diff --git a/testsuite/tests/polykinds/T7332.hs b/testsuite/tests/polykinds/T7332.hs index 0d3e7e5a13..75a6cbc991 100644 --- a/testsuite/tests/polykinds/T7332.hs +++ b/testsuite/tests/polykinds/T7332.hs @@ -9,9 +9,10 @@ module T7332 where import GHC.Exts( IsString(..) ) import Data.Monoid +import Data.Semigroup newtype DC d = DC d - deriving (Show, Monoid) + deriving (Show, Semigroup, Monoid) instance IsString (DC String) where fromString = DC diff --git a/testsuite/tests/polykinds/T7404.stderr b/testsuite/tests/polykinds/T7404.stderr deleted file mode 100644 index a8b953e5df..0000000000 --- a/testsuite/tests/polykinds/T7404.stderr +++ /dev/null @@ -1,5 +0,0 @@ - -T7404.hs:4:32: error: - Type variable ‘x’ used in a kind. - Did you mean to use TypeInType? - the declaration for type family ‘Foo’ diff --git a/testsuite/tests/polykinds/T7433.stderr b/testsuite/tests/polykinds/T7433.stderr index 1cd2ad2f29..4dce12a653 100644 --- a/testsuite/tests/polykinds/T7433.stderr +++ b/testsuite/tests/polykinds/T7433.stderr @@ -1,6 +1,6 @@ -T7433.hs:2:10: - Data constructor ‘Z’ cannot be used here - (Perhaps you intended to use DataKinds) - In the type ‘ 'Z’ - In the type declaration for ‘T’ +T7433.hs:2:10: error: + • Data constructor ‘Z’ cannot be used here + (perhaps you intended to use DataKinds) + • In the type ‘ 'Z’ + In the type declaration for ‘T’ diff --git a/testsuite/tests/polykinds/T7438.stderr b/testsuite/tests/polykinds/T7438.stderr index a198657754..6c4eec47f2 100644 --- a/testsuite/tests/polykinds/T7438.stderr +++ b/testsuite/tests/polykinds/T7438.stderr @@ -1,16 +1,16 @@ T7438.hs:6:14: error: • Couldn't match expected type ‘p1’ with actual type ‘p’ - ‘p1’ is untouchable + ‘p’ is untouchable inside the constraints: b ~ a bound by a pattern with constructor: Nil :: forall k (a :: k). Thrist a a, in an equation for ‘go’ at T7438.hs:6:4-6 - ‘p1’ is a rigid type variable bound by - the inferred type of go :: Thrist a b -> p -> p1 at T7438.hs:6:1-16 ‘p’ is a rigid type variable bound by the inferred type of go :: Thrist a b -> p -> p1 at T7438.hs:6:1-16 + ‘p1’ is a rigid type variable bound by + the inferred type of go :: Thrist a b -> p -> p1 at T7438.hs:6:1-16 Possible fix: add a type signature for ‘go’ • In the expression: acc In an equation for ‘go’: go Nil acc = acc diff --git a/testsuite/tests/polykinds/T7594.hs b/testsuite/tests/polykinds/T7594.hs index ae21956d45..925b3f9ace 100644 --- a/testsuite/tests/polykinds/T7594.hs +++ b/testsuite/tests/polykinds/T7594.hs @@ -10,9 +10,11 @@ module T7594 where -import GHC.Exts (Constraint) +import Data.Kind (Constraint, Type) -class (c1 t, c2 t) => (:&:) (c1 :: * -> Constraint) (c2 :: * -> Constraint) (t :: *) +class (c1 t, c2 t) => (:&:) (c1 :: Type -> Constraint) + (c2 :: Type -> Constraint) + (t :: Type) instance (c1 t, c2 t) => (:&:) c1 c2 t data ColD c where diff --git a/testsuite/tests/polykinds/T7594.stderr b/testsuite/tests/polykinds/T7594.stderr index 3ea08a3fb8..5632e97707 100644 --- a/testsuite/tests/polykinds/T7594.stderr +++ b/testsuite/tests/polykinds/T7594.stderr @@ -1,17 +1,18 @@ -T7594.hs:35:12: error: +T7594.hs:37:12: error: • Couldn't match type ‘b’ with ‘IO ()’ ‘b’ is untouchable inside the constraints: (:&:) c0 Real a bound by a type expected by the context: forall a. (:&:) c0 Real a => a -> b - at T7594.hs:35:8-19 + at T7594.hs:37:12-16 ‘b’ is a rigid type variable bound by - the inferred type of bar2 :: b at T7594.hs:35:1-19 + the inferred type of bar2 :: b + at T7594.hs:37:1-19 Possible fix: add a type signature for ‘bar2’ Expected type: a -> b Actual type: a -> IO () • In the first argument of ‘app’, namely ‘print’ In the expression: app print q2 In an equation for ‘bar2’: bar2 = app print q2 - • Relevant bindings include bar2 :: b (bound at T7594.hs:35:1) + • Relevant bindings include bar2 :: b (bound at T7594.hs:37:1) diff --git a/testsuite/tests/polykinds/T8132.stderr b/testsuite/tests/polykinds/T8132.stderr index a1aaa1319a..f53a78cd6d 100644 --- a/testsuite/tests/polykinds/T8132.stderr +++ b/testsuite/tests/polykinds/T8132.stderr @@ -1,4 +1,4 @@ -T8132.hs:7:1: error: +T8132.hs:7:10: error: • Class ‘Typeable’ does not support user-specified instances • In the instance declaration for ‘Typeable K’ diff --git a/testsuite/tests/polykinds/T8566.hs b/testsuite/tests/polykinds/T8566.hs index 248febb586..2ffdecfd6e 100644 --- a/testsuite/tests/polykinds/T8566.hs +++ b/testsuite/tests/polykinds/T8566.hs @@ -10,10 +10,12 @@ module T8566 where -data U (s :: *) = forall v. AA v [U s] +import Data.Kind (Type) + +data U (s :: Type) = forall v. AA v [U s] -- AA :: forall (s:*) (v:*). v -> [U s] -> U s -data I (u :: U *) (r :: [*]) :: * where +data I (u :: U Type) (r :: [Type]) :: Type where A :: I (AA t as) r -- Existential k -- A :: forall (u:U *) (r:[*]) Universal @@ -22,7 +24,7 @@ data I (u :: U *) (r :: [*]) :: * where -- I u r -- fs unused, but needs to be present for the bug -class C (u :: U *) (r :: [*]) (fs :: [*]) where +class C (u :: U Type) (r :: [Type]) (fs :: [Type]) where c :: I u r -> I u r -- c :: forall (u :: U *) (r :: [*]) (fs :: [*]). C u r fs => I u r -> I u r diff --git a/testsuite/tests/polykinds/T8566.stderr b/testsuite/tests/polykinds/T8566.stderr index 1e7818c5ef..23dddf66c7 100644 --- a/testsuite/tests/polykinds/T8566.stderr +++ b/testsuite/tests/polykinds/T8566.stderr @@ -1,18 +1,18 @@ -T8566.hs:32:9: error: +T8566.hs:34:9: error: • Could not deduce (C ('AA (t (I a ps)) as) ps fs0) arising from a use of ‘c’ from the context: C ('AA (t (I a ps)) as) ps fs - bound by the instance declaration at T8566.hs:30:10-67 + bound by the instance declaration at T8566.hs:32:10-67 or from: 'AA t (a : as) ~ 'AA t1 as1 bound by a pattern with constructor: - A :: forall (r :: [*]) v (t :: v) (as :: [U *]). I ('AA t as) r, + A :: forall v (t :: v) (as :: [U *]) (r :: [*]). I ('AA t as) r, in an equation for ‘c’ - at T8566.hs:32:5 + at T8566.hs:34:5 The type variable ‘fs0’ is ambiguous Relevant bindings include c :: I ('AA t (a : as)) ps -> I ('AA t (a : as)) ps - (bound at T8566.hs:32:3) + (bound at T8566.hs:34:3) • In the expression: c undefined In an equation for ‘c’: c A = c undefined In the instance declaration for ‘C ('AA t (a : as)) ps fs’ diff --git a/testsuite/tests/polykinds/T8566a.hs b/testsuite/tests/polykinds/T8566a.hs index 3d20c3e27d..22b628553f 100644 --- a/testsuite/tests/polykinds/T8566a.hs +++ b/testsuite/tests/polykinds/T8566a.hs @@ -6,13 +6,15 @@ {-# LANGUAGE TypeOperators #-} module T8566a where +import Data.Kind (Type) + data Field = forall k. APP k [Field] -data InField (u :: Field) :: * where +data InField (u :: Field) :: Type where A :: AppVars t (ExpandField args) -> InField (APP t args) -type family ExpandField (args :: [Field]) :: [*] -type family AppVars (t :: k) (vs :: [*]) :: * +type family ExpandField (args :: [Field]) :: [Type] +type family AppVars (t :: k) (vs :: [Type]) :: Type -- This function fails to compile, because we discard -- 'given' kind equalities. See comment 7 in Trac #8566 diff --git a/testsuite/tests/polykinds/T8616.stderr b/testsuite/tests/polykinds/T8616.stderr index 00c9c6328e..9aa4ab50d9 100644 --- a/testsuite/tests/polykinds/T8616.stderr +++ b/testsuite/tests/polykinds/T8616.stderr @@ -1,8 +1,14 @@ -T8616.hs:8:29: error: - • Expected a type, but ‘Any’ has kind ‘k’ - • In an expression type signature: (Any :: k) - In the expression: undefined :: (Any :: k) +T8616.hs:8:16: error: + • Couldn't match kind ‘k’ with ‘*’ + ‘k’ is a rigid type variable bound by + the type signature for: + withSomeSing :: forall k (kproxy :: k). Proxy kproxy + at T8616.hs:7:1-50 + When matching types + a0 :: * + Any :: k + • In the expression: undefined :: (Any :: k) In an equation for ‘withSomeSing’: withSomeSing = undefined :: (Any :: k) • Relevant bindings include diff --git a/testsuite/tests/polykinds/T8985.hs b/testsuite/tests/polykinds/T8985.hs index 28a354be27..d9e8d2c66a 100644 --- a/testsuite/tests/polykinds/T8985.hs +++ b/testsuite/tests/polykinds/T8985.hs @@ -1,12 +1,14 @@ {-# LANGUAGE DataKinds, PolyKinds, TypeFamilies, GADTs, TypeOperators #-} -module T8905 where +module T8985 where + +import Data.Kind (Type) data X (xs :: [k]) = MkX -data Y :: (k -> *) -> [k] -> * where +data Y :: (k -> Type) -> [k] -> Type where MkY :: f x -> Y f (x ': xs) -type family F (a :: [[*]]) :: * +type family F (a :: [[Type]]) :: Type type instance F xss = Y X xss works :: Y X '[ '[ ] ] -> () diff --git a/testsuite/tests/polykinds/T9017.stderr b/testsuite/tests/polykinds/T9017.stderr index 79a9a4617f..d9483c8490 100644 --- a/testsuite/tests/polykinds/T9017.stderr +++ b/testsuite/tests/polykinds/T9017.stderr @@ -1,12 +1,16 @@ T9017.hs:8:7: error: - • Couldn't match kind ‘k’ with ‘*’ - ‘k’ is a rigid type variable bound by + • Couldn't match kind ‘k1’ with ‘*’ + ‘k1’ is a rigid type variable bound by the type signature for: foo :: forall k k1 (a :: k -> k1 -> *) (b :: k) (m :: k -> k1). a b (m b) at T9017.hs:7:1-16 - When matching the kind of ‘a’ + When matching types + a1 :: * -> * -> * + a :: k -> k1 -> * + Expected type: a b (m b) + Actual type: a1 a0 (m0 a0) • In the expression: arr return In an equation for ‘foo’: foo = arr return • Relevant bindings include diff --git a/testsuite/tests/polykinds/T9200b.stderr b/testsuite/tests/polykinds/T9200b.stderr index 22f9df73f1..7c3cb65bd0 100644 --- a/testsuite/tests/polykinds/T9200b.stderr +++ b/testsuite/tests/polykinds/T9200b.stderr @@ -1,5 +1,5 @@ T9200b.hs:8:5: error: - Expected kind ‘k’, but ‘'True’ has kind ‘Bool’ - In the first argument of ‘F’, namely ‘True’ - In the type family declaration for ‘F’ + • Expected kind ‘k’, but ‘True’ has kind ‘Bool’ + • In the first argument of ‘F’, namely ‘True’ + In the type family declaration for ‘F’ diff --git a/testsuite/tests/polykinds/T9222.hs b/testsuite/tests/polykinds/T9222.hs index 8e46ccb3c5..3af1458427 100644 --- a/testsuite/tests/polykinds/T9222.hs +++ b/testsuite/tests/polykinds/T9222.hs @@ -1,6 +1,7 @@ {-# LANGUAGE RankNTypes, GADTs, DataKinds, PolyKinds, TypeOperators, TypeFamilies #-} module T9222 where +import Data.Kind import Data.Proxy -- Nov 2014: actually the type of Want is ambiguous if we @@ -9,5 +10,5 @@ import Data.Proxy -- So this program is erroneous. (But the original ticket was -- a crash, and that's still fixed!) -data Want :: (i,j) -> * where +data Want :: (i,j) -> Type where Want :: (a ~ '(b,c) => Proxy b) -> Want a diff --git a/testsuite/tests/polykinds/T9222.stderr b/testsuite/tests/polykinds/T9222.stderr index 6e143e0cf9..94e0c16f95 100644 --- a/testsuite/tests/polykinds/T9222.stderr +++ b/testsuite/tests/polykinds/T9222.stderr @@ -1,16 +1,16 @@ -T9222.hs:13:3: error: +T9222.hs:14:3: error: • Couldn't match type ‘c0’ with ‘c’ ‘c0’ is untouchable inside the constraints: a ~ '(b0, c0) - bound by the type of the constructor ‘Want’: + bound by a type expected by the context: (a ~ '(b0, c0)) => Proxy b0 - at T9222.hs:13:3 + at T9222.hs:14:3-43 ‘c’ is a rigid type variable bound by the type of the constructor ‘Want’: forall i1 j1 (a :: (i1, j1)) (b :: i1) (c :: j1). ((a ~ '(b, c)) => Proxy b) -> Want a - at T9222.hs:13:3 + at T9222.hs:14:3-43 • In the ambiguity check for ‘Want’ To defer the ambiguity check to use sites, enable AllowAmbiguousTypes In the definition of data constructor ‘Want’ diff --git a/testsuite/tests/polykinds/T9574.stderr b/testsuite/tests/polykinds/T9574.stderr deleted file mode 100644 index 50b42ad590..0000000000 --- a/testsuite/tests/polykinds/T9574.stderr +++ /dev/null @@ -1,4 +0,0 @@ - -T9574.hs:11:5: - The RHS of an associated type declaration mentions ‘o’ - All such variables must be bound on the LHS diff --git a/testsuite/tests/polykinds/T9725.hs b/testsuite/tests/polykinds/T9725.hs new file mode 100644 index 0000000000..9a3d529d96 --- /dev/null +++ b/testsuite/tests/polykinds/T9725.hs @@ -0,0 +1,51 @@ +{-# LANGUAGE GADTs, DataKinds, KindSignatures, PolyKinds, FlexibleContexts, RankNTypes, ScopedTypeVariables #-} +module T9725 where + +data En = M Bool +class Kn (l :: En) + +instance Kn (M b) + +data Fac :: En -> * where + Mo :: Kn (M b) => Fac (M b) + +data Fm :: * -> * where + HiF :: Kn (ent b) => Fm (Fac (ent b)) -> Fm (O ent) + MoF :: Kn (M b) => Fm (Fac (M b)) + +data O :: (k -> En) -> * where + Hi :: Fac (ent k) -> O ent + +data Co :: (* -> *) -> * -> * where + Ab :: (t -> f t) -> Co f t + +-- Restricted kind signature: +--test :: forall (ent :: Bool -> En) . (forall i . Kn (ent i) => Fm (Fac (ent i))) -> Co Fm (O ent) + +test :: forall ent . (forall i . Kn (ent i) => Fm (Fac (ent i))) -> Co Fm (O ent) +test de = Ab h + where h :: O ent -> Fm (O ent) + h (Hi m@Mo) = HiF (d m) + d :: Kn (ent i) => Fac (ent i) -> Fm (Fac (ent i)) + d _ = de + +{- +9725.hs:27:25: + Could not deduce (Kn (ent k1)) arising from a use of ‘HiF’ + from the context (ent k1 ~ 'M b, Kn ('M b)) + bound by a pattern with constructor + Mo :: forall (b :: Bool). Kn ('M b) => Fac ('M b), + in an equation for ‘h’ + at 9725.hs:27:19-20 + In the expression: HiF (d m) + In an equation for ‘h’: h (Hi m@Mo) = HiF (d m) + In an equation for ‘test’: + test de + = Ab h + where + h :: O ent -> Fm (O ent) + h (Hi m@Mo) = HiF (d m) + d :: Kn (ent i) => Fac (ent i) -> Fm (Fac (ent i)) + d _ = de +Failed, modules loaded: none. +-} diff --git a/testsuite/tests/polykinds/SigTvKinds.hs b/testsuite/tests/polykinds/TyVarTvKinds.hs index 782a7b3f8b..a3a0de3da4 100644 --- a/testsuite/tests/polykinds/SigTvKinds.hs +++ b/testsuite/tests/polykinds/TyVarTvKinds.hs @@ -1,6 +1,6 @@ {-# LANGUAGE PolyKinds #-} -module SigTvKinds where +module TyVarTvKinds where data T (a :: k1) x = MkT (S a ()) data S (b :: k2) y = MkS (T b ()) diff --git a/testsuite/tests/polykinds/SigTvKinds2.hs b/testsuite/tests/polykinds/TyVarTvKinds2.hs index 1ec1ebb0f6..49817d7925 100644 --- a/testsuite/tests/polykinds/SigTvKinds2.hs +++ b/testsuite/tests/polykinds/TyVarTvKinds2.hs @@ -1,6 +1,6 @@ {-# LANGUAGE PolyKinds #-} -module SigTvKinds2 where +module TyVarTvKinds2 where data SameKind :: k -> k -> * diff --git a/testsuite/tests/polykinds/SigTvKinds2.stderr b/testsuite/tests/polykinds/TyVarTvKinds2.stderr index 9f523705a6..1a552883d2 100644 --- a/testsuite/tests/polykinds/SigTvKinds2.stderr +++ b/testsuite/tests/polykinds/TyVarTvKinds2.stderr @@ -1,5 +1,5 @@ -SigTvKinds2.hs:7:48: error: +TyVarTvKinds2.hs:7:48: error: • Expected kind ‘k1’, but ‘b’ has kind ‘k2’ • In the second argument of ‘SameKind’, namely ‘b’ In the type ‘SameKind a b’ diff --git a/testsuite/tests/polykinds/TyVarTvKinds3.hs b/testsuite/tests/polykinds/TyVarTvKinds3.hs new file mode 100644 index 0000000000..570078c863 --- /dev/null +++ b/testsuite/tests/polykinds/TyVarTvKinds3.hs @@ -0,0 +1,9 @@ +{-# LANGUAGE GADTs, ExplicitForAll, PolyKinds #-} + +module TyVarTvKinds3 where + +import Data.Kind + +data SameKind :: k -> k -> Type +data Bad a where + MkBad :: forall k1 k2 (a :: k1) (b :: k2). Bad (SameKind a b) diff --git a/testsuite/tests/polykinds/TyVarTvKinds3.stderr b/testsuite/tests/polykinds/TyVarTvKinds3.stderr new file mode 100644 index 0000000000..67da965d09 --- /dev/null +++ b/testsuite/tests/polykinds/TyVarTvKinds3.stderr @@ -0,0 +1,6 @@ + +TyVarTvKinds3.hs:9:62: error: + • Expected kind ‘k1’, but ‘b’ has kind ‘k2’ + • In the second argument of ‘SameKind’, namely ‘b’ + In the first argument of ‘Bad’, namely ‘(SameKind a b)’ + In the type ‘Bad (SameKind a b)’ diff --git a/testsuite/tests/polykinds/all.T b/testsuite/tests/polykinds/all.T index 900faca994..ae4ee51a21 100644 --- a/testsuite/tests/polykinds/all.T +++ b/testsuite/tests/polykinds/all.T @@ -37,8 +37,8 @@ test('T6035', normal, compile, ['']) test('T6036', normal, compile, ['']) test('T6025', normal, run_command, ['$MAKE -s --no-print-directory T6025']) test('T6002', normal, compile, ['']) -test('T6039', normal, compile_fail, ['']) -test('T6021', normal, compile_fail, ['']) +test('T6039', normal, compile, ['']) +test('T6021', normal, compile, ['']) test('T6020a', normal, compile, ['']) test('T6044', normal, compile, ['']) test('T6054', normal, run_command, ['$MAKE -s --no-print-directory T6054']) @@ -74,7 +74,7 @@ test('T7341', normal, compile_fail,['']) test('T7422', normal, compile,['']) test('T7433', normal, compile_fail,['']) test('T7438', normal, run_command, ['$MAKE -s --no-print-directory T7438']) -test('T7404', normal, compile_fail,['']) +test('T7404', normal, compile,['']) test('T7502', normal, compile,['']) test('T7488', normal, compile,['']) test('T7594', normal, compile_fail,['']) @@ -103,10 +103,11 @@ test('T9263', normal, run_command, ['$MAKE -s --no-print-directory T9263']) test('T9063', normal, compile, ['']) test('T9200', normal, compile, ['']) test('T9200b', normal, compile_fail, ['']) +test('T9725', normal, compile, ['']) test('T9750', normal, compile, ['']) test('T9569', normal, compile, ['']) test('T9838', normal, multimod_compile, ['T9838.hs','-v0']) -test('T9574', normal, compile_fail, ['']) +test('T9574', normal, compile, ['']) test('T9833', normal, compile, ['']) test('T7908', normal, compile, ['']) test('PolyInstances', normal, compile, ['']) @@ -121,8 +122,8 @@ test('T10134', normal, multimod_compile, ['T10134.hs','-v0']) test('T10742', normal, compile, ['']) test('T10934', normal, compile, ['']) test('T11142', normal, compile_fail, ['']) -test('SigTvKinds', normal, compile, ['']) -test('SigTvKinds2', expect_broken(11203), compile_fail, ['']) +test('TyVarTvKinds', normal, compile, ['']) +test('TyVarTvKinds2', expect_broken(11203), compile_fail, ['']) test('T9017', normal, compile_fail, ['']) test('TidyClassKinds', normal, compile_fail, ['-fprint-explicit-kinds']) test('T11249', normal, compile, ['']) @@ -142,10 +143,10 @@ test('T11399', normal, compile_fail, ['']) test('T11611', normal, compile_fail, ['']) test('T11616', normal, compile, ['']) test('T11648', normal, compile, ['']) -test('T11648b', normal, compile_fail, ['']) +test('T11648b', normal, compile, ['']) test('KindVType', normal, compile_fail, ['']) test('T11821', normal, compile, ['']) -test('T11821a', normal, compile, ['']) +test('T11821a', normal, compile_fail, ['']) test('T11640', normal, compile, ['']) test('T11554', normal, compile_fail, ['']) test('T12055', normal, compile, ['']) @@ -160,6 +161,35 @@ test('T13394a', normal, compile, ['']) test('T13394', normal, compile, ['']) test('T13371', normal, compile, ['']) test('T13393', normal, compile_fail, ['']) -test('T13555', normal, compile_fail, ['']) +test('T13555', normal, compile, ['']) test('T13659', normal, compile_fail, ['']) test('T13625', normal, compile_fail, ['']) +test('T13985', normal, compile_fail, ['']) +test('T14110', normal, compile_fail, ['']) +test('BadKindVar', normal, compile_fail, ['']) +test('T13738', normal, compile_fail, ['']) +test('T14209', normal, compile, ['']) +test('T14265', normal, compile_fail, ['']) +test('T13391a', normal, compile, ['']) +test('T14270', normal, compile, ['']) +test('T14450', normal, compile_fail, ['']) +test('T14172', normal, multimod_compile_fail, ['T14172.hs','-v0']) +test('T14174', normal, compile_fail, ['']) +test('T14174a', normal, compile, ['']) +test('T14520', normal, compile_fail, ['-fprint-explicit-kinds']) +test('T11203', normal, compile_fail, ['']) +test('T14555', normal, compile_fail, ['-fprint-explicit-runtime-reps']) +test('T14563', normal, compile_fail, ['-fprint-explicit-runtime-reps']) +test('T14561', normal, compile_fail, ['']) +test('T14580', normal, compile_fail, ['']) +test('T14515', normal, compile, ['']) +test('T14710', normal, compile_fail, ['']) +test('T14723', normal, compile, ['']) +test('T14846', normal, compile_fail, ['']) +test('T14873', normal, compile, ['']) +test('TyVarTvKinds3', normal, compile_fail, ['']) +test('T15116', normal, compile_fail, ['']) +test('T15116a', normal, compile_fail, ['']) +test('T15170', normal, compile, ['']) +test('T14939', normal, compile, ['-O']) +test('T15577', normal, compile_fail, ['-O']) diff --git a/testsuite/tests/primops/should_run/T13825-compile.hs b/testsuite/tests/primops/should_run/T13825-compile.hs new file mode 100644 index 0000000000..04a72b38e9 --- /dev/null +++ b/testsuite/tests/primops/should_run/T13825-compile.hs @@ -0,0 +1,66 @@ +{-# LANGUAGE MagicHash #-} +module Main where + +import GHC.Exts +import Data.Word +import Data.Int + +data Packed1 = Packed1 Float# Float# Int# Float# + deriving Show + +data Packed2 = + Packed2 + {-# UNPACK #-} !Float + {-# UNPACK #-} !Float + {-# UNPACK #-} !Int + {-# UNPACK #-} !Float + deriving Show + +data Packed3 = + Packed3 + {-# UNPACK #-} !Word8 + {-# UNPACK #-} !Int8 + {-# UNPACK #-} !Int64 + {-# UNPACK #-} !Float + {-# UNPACK #-} !Word64 + {-# UNPACK #-} !Word32 + {-# UNPACK #-} !Float + {-# UNPACK #-} !Double + deriving Show + +packed1 = go 0.0# 1.0# 2# 3.0# + where + go a b c d = + Packed1 a b c d + : go (a `plusFloat#` 1.0#) + (b `plusFloat#` 1.0#) + (c +# 1#) + (d `plusFloat#` 1.0#) + +packed2 = + [ Packed2 + (fromIntegral i) + (fromIntegral (i + 1)) + (fromIntegral (i + 2)) + (fromIntegral (i + 3)) + | i <- [0..] + ] + +packed3 = + [ Packed3 + (fromIntegral i) + (fromIntegral (i + 1)) + (fromIntegral (i + 2)) + (fromIntegral (i + 3)) + (fromIntegral (i + 4)) + (fromIntegral (i + 5)) + (fromIntegral (i + 6)) + (fromIntegral (i + 6)) + | i <- [0..] + ] + +main :: IO () +main = do + print (take 3 packed1) + print (take 3 packed2) + print (take 3 packed3) diff --git a/testsuite/tests/primops/should_run/T13825-compile.stdout b/testsuite/tests/primops/should_run/T13825-compile.stdout new file mode 100644 index 0000000000..41a5fb1368 --- /dev/null +++ b/testsuite/tests/primops/should_run/T13825-compile.stdout @@ -0,0 +1,3 @@ +[Packed1 0.0# 1.0# 2# 3.0#,Packed1 1.0# 2.0# 3# 4.0#,Packed1 2.0# 3.0# 4# 5.0#] +[Packed2 0.0 1.0 2 3.0,Packed2 1.0 2.0 3 4.0,Packed2 2.0 3.0 4 5.0] +[Packed3 0 1 2 3.0 4 5 6.0 6.0,Packed3 1 2 3 4.0 5 6 7.0 7.0,Packed3 2 3 4 5.0 6 7 8.0 8.0] diff --git a/testsuite/tests/primops/should_run/T4442.hs b/testsuite/tests/primops/should_run/T4442.hs new file mode 100644 index 0000000000..d9e65006bc --- /dev/null +++ b/testsuite/tests/primops/should_run/T4442.hs @@ -0,0 +1,312 @@ +{-# LANGUAGE MagicHash, UnboxedTuples, CPP #-} +module Main where + +#include "MachDeps.h" + +import GHC.Ptr(Ptr(..), nullPtr, plusPtr, minusPtr) +import GHC.Stable( + StablePtr(..), castStablePtrToPtr, castPtrToStablePtr, newStablePtr) +import GHC.Exts +import Data.Char(ord) +#if WORD_SIZE_IN_BITS < 64 +import GHC.Int (Int64(..)) +import GHC.Word (Word64(..)) +#endif + +assertEqual :: (Show a, Eq a) => a -> a -> IO () +assertEqual a b + | a /= b = putStrLn (show a ++ " /= " ++ show b) + | otherwise = return () + +readBytes :: MutableByteArray# s -> State# s -> Int# -> (# State# s, [Int] #) +readBytes marr s0 len = go s0 len [] + where + go s 0# bs = (# s, bs #) + go s i bs = case readWord8Array# marr (i -# 1#) s of + (# s', b #) -> go s' (i -# 1#) (I# (word2Int# b):bs) + +indexBytes :: ByteArray# -> Int# -> [Int] +indexBytes arr len = + [I# (word2Int# (indexWord8Array# arr i)) | I# i <- [0..I# len - 1]] + +fillByteArray :: MutableByteArray# s -> Int# -> Int -> State# s -> State# s +fillByteArray arr len (I# a) = go len + where + go 0# s = s + go i s = go (i -# 1#) (writeInt8Array# arr (i -# 1#) a s) + +test :: (Eq a, Show a) + => String + -> (ByteArray# -> Int# -> a) + -> (MutableByteArray# RealWorld -> Int# -> State# RealWorld + -> (# State# RealWorld, a #)) + -> (MutableByteArray# RealWorld -> Int# -> a -> State# RealWorld + -> State# RealWorld) + -> a + -> [Int] + -> Int + -> IO () +test name index read write val valBytes len = do + putStrLn name + mapM_ testAtOffset [0..16] + where + arrLen :: Int# + arrLen = 24# + + fillerByte :: Int + fillerByte = 0x34 + + expectedArrayBytes :: Int -> [Int] + expectedArrayBytes offset = + replicate offset fillerByte + ++ valBytes + ++ replicate (I# arrLen - len - offset) fillerByte + + testAtOffset :: Int -> IO () + testAtOffset offset@(I# offset#) = runRW# (\s0 -> let + (# s1, marr #) = newByteArray# arrLen s0 + s2 = fillByteArray marr arrLen fillerByte s1 + s3 = write marr offset# val s2 + (# s4, actual0 #) = read marr offset# s3 + (# s5, actualBytes0 #) = readBytes marr s4 arrLen + (# _, arr #) = unsafeFreezeByteArray# marr s5 + actual1 = index arr offset# + actualBytes1 = indexBytes arr arrLen + in do + assertEqual actual0 val + assertEqual actual1 val + assertEqual actualBytes0 (expectedArrayBytes offset) + assertEqual actualBytes1 (expectedArrayBytes offset) + ) + +intToBytes :: Int -> Int -> [Int] +intToBytes (I# val0) (I# len0) = let + result = go val0 len0 + go v 0# = [] + go v len = + I# (v `andI#` 0xff#) : go (v `uncheckedIShiftRL#` 8#) (len -# 1#) + in +#if defined(WORDS_BIGENDIAN) + reverse result +#else + result +#endif + +testIntArray :: + String + -> (ByteArray# -> Int# -> Int#) + -> (MutableByteArray# RealWorld -> Int# -> State# RealWorld + -> (# State# RealWorld, Int# #)) + -> (MutableByteArray# RealWorld -> Int# -> Int# -> State# RealWorld + -> State# RealWorld) + -> Int + -> Int + -> IO () +testIntArray name0 index read write val0 len = do + doOne (name0 ++ " positive") val0 + doOne (name0 ++ " negative") (negate val0) + where + doOne name val = test + name + (\arr i -> I# (index arr i)) + (\arr i s -> case read arr i s of (# s', a #) -> (# s', I# a #)) + (\arr i (I# a) s -> write arr i a s) + val + (intToBytes val len) + len + +#if WORD_SIZE_IN_BITS == 64 +testInt64Array = testIntArray +#else +testInt64Array :: + String + -> (ByteArray# -> Int# -> Int64#) + -> (MutableByteArray# RealWorld -> Int# -> State# RealWorld + -> (# State# RealWorld, Int64# #)) + -> (MutableByteArray# RealWorld -> Int# -> Int64# -> State# RealWorld + -> State# RealWorld) + -> Int64 + -> Int + -> IO () +testInt64Array name0 index read write val0 len = do + doOne (name0 ++ " positive") val0 + doOne (name0 ++ " negative") (negate val0) + where + doOne :: String -> Int64 -> IO () + doOne name val = test + name + (\arr i -> I64# (index arr i)) + (\arr i s -> case read arr i s of (# s', a #) -> (# s', I64# a #)) + (\arr i (I64# a) s -> write arr i a s) + val + (intToBytes (fromIntegral val) len) + len +#endif + +testWordArray :: + String + -> (ByteArray# -> Int# -> Word#) + -> (MutableByteArray# RealWorld -> Int# -> State# RealWorld + -> (# State# RealWorld, Word# #)) + -> (MutableByteArray# RealWorld -> Int# -> Word# -> State# RealWorld + -> State# RealWorld) + -> Word + -> Int + -> IO () +testWordArray name index read write val len = test + name + (\arr i -> W# (index arr i)) + (\arr i s -> case read arr i s of (# s', a #) -> (# s', W# a #)) + (\arr i (W# a) s -> write arr i a s) + val + (intToBytes (fromIntegral val) len) + len + +#if WORD_SIZE_IN_BITS == 64 +testWord64Array = testWordArray +#else +testWord64Array :: + String + -> (ByteArray# -> Int# -> Word64#) + -> (MutableByteArray# RealWorld -> Int# -> State# RealWorld + -> (# State# RealWorld, Word64# #)) + -> (MutableByteArray# RealWorld -> Int# -> Word64# -> State# RealWorld + -> State# RealWorld) + -> Word64 + -> Int + -> IO () +testWord64Array name index read write val len = test + name + (\arr i -> W64# (index arr i)) + (\arr i s -> case read arr i s of (# s', a #) -> (# s', W64# a #)) + (\arr i (W64# a) s -> write arr i a s) + val + (intToBytes (fromIntegral val) len) + len +#endif + +wordSizeInBytes :: Int +wordSizeInBytes = WORD_SIZE_IN_BITS `div` 8 + +int :: Int +int + | WORD_SIZE_IN_BITS == 32 = 12345678 + | otherwise = 1234567890123 + +word :: Word +word = fromIntegral int + +float :: Float +float = 123.456789 + +-- Test pattern generated by this python code: +-- >>> import struct +-- >>> import binascii +-- >>> binascii.hexlify(struct.pack('>f', 123.456789)) +floatBytes :: Int +floatBytes = 0x42f6e9e0 + +double :: Double +double = 123.45678901234 + +-- Test pattern generated by this python code: +-- >>> import struct +-- >>> import binascii +-- >>> binascii.hexlify(struct.pack('>d', 123.45678901234)) +doubleBytes :: Int +doubleBytes = 0x405edd3c07fb4b09 + +main :: IO () +main = do + testIntArray "Int8#" + indexInt8Array# readInt8Array# writeInt8Array# + 123 1 + testIntArray "Int16#" + indexWord8ArrayAsInt16# readWord8ArrayAsInt16# writeWord8ArrayAsInt16# + 12345 2 + testIntArray "Int32#" + indexWord8ArrayAsInt32# readWord8ArrayAsInt32# writeWord8ArrayAsInt32# + 12345678 4 + testInt64Array "Int64#" + indexWord8ArrayAsInt64# readWord8ArrayAsInt64# writeWord8ArrayAsInt64# + 1234567890123 8 + testIntArray "Int#" + indexWord8ArrayAsInt# readWord8ArrayAsInt# writeWord8ArrayAsInt# + int wordSizeInBytes + + testWordArray "Word8#" + indexWord8Array# readWord8Array# writeWord8Array# + 123 1 + testWordArray "Word16#" + indexWord8ArrayAsWord16# readWord8ArrayAsWord16# writeWord8ArrayAsWord16# + 12345 2 + testWordArray "Word32#" + indexWord8ArrayAsWord32# readWord8ArrayAsWord32# writeWord8ArrayAsWord32# + 12345678 4 + testWord64Array "Word64#" + indexWord8ArrayAsWord64# readWord8ArrayAsWord64# writeWord8ArrayAsWord64# + 1234567890123 8 + testWordArray "Word#" + indexWord8ArrayAsWord# readWord8ArrayAsWord# writeWord8ArrayAsWord# + word wordSizeInBytes + + test + "Char#" + (\arr i -> C# (indexWord8ArrayAsChar# arr i)) + (\arr i s -> + case readWord8ArrayAsChar# arr i s of (# s', a #) -> (# s', C# a #)) + (\arr i (C# a) s -> writeWord8ArrayAsChar# arr i a s) + 'z' + [ord 'z'] + 1 + test + "WideChar#" + (\arr i -> C# (indexWord8ArrayAsWideChar# arr i)) + (\arr i s -> + case readWord8ArrayAsWideChar# arr i s of (# s', a #) -> (# s', C# a #)) + (\arr i (C# a) s -> writeWord8ArrayAsWideChar# arr i a s) + '𠜎' -- See http://www.i18nguy.com/unicode/supplementary-test.html + (intToBytes (ord '𠜎') 4) + 4 + test + "Addr#" + (\arr i -> Ptr (indexWord8ArrayAsAddr# arr i)) + (\arr i s -> + case readWord8ArrayAsAddr# arr i s of (# s', a #) -> (# s', Ptr a #)) + (\arr i (Ptr a) s -> writeWord8ArrayAsAddr# arr i a s) + (nullPtr `plusPtr` int) + (intToBytes int wordSizeInBytes) + wordSizeInBytes + + stablePtr <- newStablePtr () + test + "StablePtr#" + (\arr i -> + castStablePtrToPtr (StablePtr (indexWord8ArrayAsStablePtr# arr i))) + (\arr i s -> case readWord8ArrayAsStablePtr# arr i s of + (# s', a #) -> (# s', castStablePtrToPtr (StablePtr a) #)) + (\arr i p s -> case castPtrToStablePtr p of + (StablePtr a) -> writeWord8ArrayAsStablePtr# arr i a s) + (castStablePtrToPtr stablePtr) + (intToBytes (castStablePtrToPtr stablePtr `minusPtr` nullPtr) + wordSizeInBytes) + wordSizeInBytes + + test + "Float#" + (\arr i -> F# (indexWord8ArrayAsFloat# arr i)) + (\arr i s -> + case readWord8ArrayAsFloat# arr i s of (# s', a #) -> (# s', F# a #)) + (\arr i (F# a) s -> writeWord8ArrayAsFloat# arr i a s) + float + (intToBytes floatBytes 4) + 4 + test + "Double#" + (\arr i -> D# (indexWord8ArrayAsDouble# arr i)) + (\arr i s -> + case readWord8ArrayAsDouble# arr i s of (# s', a #) -> (# s', D# a #)) + (\arr i (D# a) s -> writeWord8ArrayAsDouble# arr i a s) + double + (intToBytes doubleBytes 8) + 8 diff --git a/testsuite/tests/primops/should_run/T4442.stdout b/testsuite/tests/primops/should_run/T4442.stdout new file mode 100644 index 0000000000..8c5293d558 --- /dev/null +++ b/testsuite/tests/primops/should_run/T4442.stdout @@ -0,0 +1,21 @@ +Int8# positive +Int8# negative +Int16# positive +Int16# negative +Int32# positive +Int32# negative +Int64# positive +Int64# negative +Int# positive +Int# negative +Word8# +Word16# +Word32# +Word64# +Word# +Char# +WideChar# +Addr# +StablePtr# +Float# +Double#
\ No newline at end of file diff --git a/testsuite/tests/primops/should_run/all.T b/testsuite/tests/primops/should_run/all.T index 68a2d5609f..742206d93d 100644 --- a/testsuite/tests/primops/should_run/all.T +++ b/testsuite/tests/primops/should_run/all.T @@ -1,7 +1,10 @@ test('T6135', normal, compile_and_run, ['']) test('T7689', normal, compile_and_run, ['']) -# The test is using unboxed tuples, so omit ghci +# These tests are using unboxed tuples, so omit ghci test('T9430', omit_ways(['ghci']), compile_and_run, ['']) +test('T4442', + [omit_ways(['ghci']), when(wordsize(32), expect_broken(15184))], + compile_and_run, ['']) test('T10481', exit_code(1), compile_and_run, ['']) test('T10678', [stats_num_field('bytes allocated', @@ -13,3 +16,4 @@ test('T10678', ], compile_and_run, ['-O']) test('T11296', normal, compile_and_run, ['']) +test('T13825-compile', normal, compile_and_run, ['']) diff --git a/testsuite/tests/printer/Makefile b/testsuite/tests/printer/Makefile index 1c2f2995d0..044e44332e 100644 --- a/testsuite/tests/printer/Makefile +++ b/testsuite/tests/printer/Makefile @@ -213,3 +213,27 @@ T13550: .PHONY: T13942 T13942: $(CHECK_PPR) "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" T13942.hs + +.PHONY: T14289 +T14289: + $(CHECK_PPR) "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" T14289.hs + +.PHONY: T14289b +T14289b: + $(CHECK_PPR) "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" T14289b.hs + +.PHONY: T14289c +T14289c: + $(CHECK_PPR) "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" T14289c.hs + +.PHONY: T14306 +T14306: + $(CHECK_PPR) "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" T14306.hs + +.PHONY: T14343 +T14343: + $(CHECK_PPR) "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" T14343.hs + +.PHONY: T14343b +T14343b: + $(CHECK_PPR) "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" T14343b.hs diff --git a/testsuite/tests/printer/Ppr040.hs b/testsuite/tests/printer/Ppr040.hs index a9885a9d53..6fc7b09b15 100644 --- a/testsuite/tests/printer/Ppr040.hs +++ b/testsuite/tests/printer/Ppr040.hs @@ -1,5 +1,5 @@ {-# LANGUAGE TemplateHaskell, RankNTypes, TypeOperators, DataKinds, - PolyKinds, TypeFamilies, GADTs, TypeInType #-} + PolyKinds, TypeFamilies, GADTs, StarIsType #-} module RAE_T32a where diff --git a/testsuite/tests/printer/Ppr045.hs b/testsuite/tests/printer/Ppr045.hs index 73364982b4..b4843afc51 100644 --- a/testsuite/tests/printer/Ppr045.hs +++ b/testsuite/tests/printer/Ppr045.hs @@ -5,6 +5,7 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} +{-# LANGUAGE StarIsType #-} {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE UndecidableSuperClasses #-} {-# OPTIONS_GHC -fwarn-incomplete-patterns -fwarn-overlapping-patterns #-} diff --git a/testsuite/tests/printer/T14289.hs b/testsuite/tests/printer/T14289.hs new file mode 100644 index 0000000000..04b9176c69 --- /dev/null +++ b/testsuite/tests/printer/T14289.hs @@ -0,0 +1,32 @@ +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE TemplateHaskell #-} +{-# OPTIONS_GHC -ddump-splices -dsuppress-uniques #-} + +import Language.Haskell.TH + +class C a b + +$([d| data Foo a = Foo a deriving (C a) |]) + +{- + +Note: to debug + +~/inplace/bin/ghc-stage2 --interactive +load the following +---------------------------------------- +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE TemplateHaskell #-} +{-# OPTIONS_GHC -ddump-splices -dsuppress-uniques #-} + +import Language.Haskell.TH + +class C a b + +main :: IO () +main = putStrLn $([d| data Foo a = Foo a deriving (C a) |] >>= stringE . show) + +---------------------------------------- + +-} diff --git a/testsuite/tests/printer/T14289.stdout b/testsuite/tests/printer/T14289.stdout new file mode 100644 index 0000000000..3f0754adca --- /dev/null +++ b/testsuite/tests/printer/T14289.stdout @@ -0,0 +1,16 @@ +T14289.hs:10:3-42: Splicing declarations + [d| data Foo a + = Foo a + deriving (C a) |] + ======> + data Foo a + = Foo a + deriving (C a) +T14289.ppr.hs:(7,3)-(9,25): Splicing declarations + [d| data Foo a + = Foo a + deriving (C a) |] + ======> + data Foo a + = Foo a + deriving (C a) diff --git a/testsuite/tests/printer/T14289b.hs b/testsuite/tests/printer/T14289b.hs new file mode 100644 index 0000000000..3ff39805d6 --- /dev/null +++ b/testsuite/tests/printer/T14289b.hs @@ -0,0 +1,42 @@ +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeOperators #-} +{-# OPTIONS_GHC -ddump-splices -dsuppress-uniques #-} + +import Language.Haskell.TH + +class (a `C` b) c + +$([d| data Foo a = Foo a deriving (y `C` z) |]) + +{- + +Note: to debug + +~/inplace/bin/ghc-stage2 --interactive +load the following +---------------------------------------- +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE TemplateHaskell #-} +{-# OPTIONS_GHC -ddump-splices -dsuppress-uniques #-} + +import Language.Haskell.TH + +class (a `C` b) c + +main :: IO () +main + = putStrLn $([d| data Foo a = Foo a deriving (y `C` z) |] >>= stringE . show) + +---------------------------------------- +Bceomes + + +[DataD [] Foo_0 [PlainTV a_2] Nothing + [NormalC Foo_1 [(Bang NoSourceUnpackedness NoSourceStrictness,VarT a_2)]] + [DerivClause Nothing + [AppT (AppT (ConT Main.C) (VarT y_6989586621679027885)) + (VarT z_6989586621679027886)]]] + +-} diff --git a/testsuite/tests/printer/T14289b.stdout b/testsuite/tests/printer/T14289b.stdout new file mode 100644 index 0000000000..5d4b248ac3 --- /dev/null +++ b/testsuite/tests/printer/T14289b.stdout @@ -0,0 +1,16 @@ +T14289b.hs:11:3-46: Splicing declarations + [d| data Foo a + = Foo a + deriving (y `C` z) |] + ======> + data Foo a + = Foo a + deriving (C y z) +T14289b.ppr.hs:(8,3)-(10,29): Splicing declarations + [d| data Foo a + = Foo a + deriving (y `C` z) |] + ======> + data Foo a + = Foo a + deriving (C y z) diff --git a/testsuite/tests/printer/T14289c.hs b/testsuite/tests/printer/T14289c.hs new file mode 100644 index 0000000000..6e58df1a54 --- /dev/null +++ b/testsuite/tests/printer/T14289c.hs @@ -0,0 +1,40 @@ +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeOperators #-} +{-# OPTIONS_GHC -ddump-splices -dsuppress-uniques #-} + +import Language.Haskell.TH + +$([d| data Foo a = Foo a deriving (a ~ a) |]) + +{- + +Note: to debug + +~/inplace/bin/ghc-stage2 --interactive +load the following +---------------------------------------- +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE TemplateHaskell #-} +{-# OPTIONS_GHC -ddump-splices -dsuppress-uniques #-} + +import Language.Haskell.TH + +class (a `C` b) c + +main :: IO () +main + = putStrLn $([d| data Foo a = Foo a deriving (a ~ a) |] >>= stringE . show) + +---------------------------------------- +Becomes + +[DataD [] Foo_0 [PlainTV a_2] Nothing + [NormalC Foo_1 [(Bang NoSourceUnpackedness NoSourceStrictness,VarT a_2)]] + [DerivClause Nothing + [AppT (AppT EqualityT (VarT a_2)) + (VarT a_2)]]] + + +-} diff --git a/testsuite/tests/printer/T14289c.stdout b/testsuite/tests/printer/T14289c.stdout new file mode 100644 index 0000000000..d200f99a2b --- /dev/null +++ b/testsuite/tests/printer/T14289c.stdout @@ -0,0 +1,16 @@ +T14289c.hs:9:3-44: Splicing declarations + [d| data Foo a + = Foo a + deriving (a ~ a) |] + ======> + data Foo a + = Foo a + deriving (a ~ a) +T14289c.ppr.hs:(7,3)-(9,27): Splicing declarations + [d| data Foo a + = Foo a + deriving (a ~ a) |] + ======> + data Foo a + = Foo a + deriving (a ~ a) diff --git a/testsuite/tests/printer/T14306.hs b/testsuite/tests/printer/T14306.hs new file mode 100644 index 0000000000..c39807e4d3 --- /dev/null +++ b/testsuite/tests/printer/T14306.hs @@ -0,0 +1,10 @@ +{-# LANGUAGE MultiParamTypeClasses #-} +module T14306 where + +class (a `C` b) c + +class (a `D` b) c d + +class (a `E` b) + +class a `F` b diff --git a/testsuite/tests/printer/T14343.hs b/testsuite/tests/printer/T14343.hs new file mode 100644 index 0000000000..1fe6a9660b --- /dev/null +++ b/testsuite/tests/printer/T14343.hs @@ -0,0 +1,12 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE PolyKinds #-} +{-# OPTIONS_GHC -Werror=typed-holes #-} + +main :: IO () +main = undefined + +data Proxy k = Proxy + +test1 = _ :: Proxy '[ 'True ] +test2 = _ :: Proxy '[ '[ 1 ] ] +test3 = _ :: Proxy '[ '( "Symbol", 1 ) ] diff --git a/testsuite/tests/printer/T14343.stderr b/testsuite/tests/printer/T14343.stderr new file mode 100644 index 0000000000..1bceb67403 --- /dev/null +++ b/testsuite/tests/printer/T14343.stderr @@ -0,0 +1,36 @@ + +T14343.hs:10:9: error: + • Found hole: _ :: Proxy '[ 'True] + • In the expression: _ :: Proxy '[ 'True] + In an equation for ‘test1’: test1 = _ :: Proxy '[ 'True] + • Relevant bindings include + test1 :: Proxy '[ 'True] (bound at T14343.hs:10:1) + Valid hole fits include + test1 :: Proxy '[ 'True] (defined at T14343.hs:10:1) + Proxy :: forall k1 (k2 :: k1). Proxy k2 + with Proxy @[Bool] @'[ 'True] + (defined at T14343.hs:8:16) + +T14343.hs:11:9: error: + • Found hole: _ :: Proxy '[ '[1]] + • In the expression: _ :: Proxy '['[1]] + In an equation for ‘test2’: test2 = _ :: Proxy '['[1]] + • Relevant bindings include + test2 :: Proxy '[ '[1]] (bound at T14343.hs:11:1) + Valid hole fits include + test2 :: Proxy '[ '[1]] (defined at T14343.hs:11:1) + Proxy :: forall k1 (k2 :: k1). Proxy k2 + with Proxy @[[GHC.Types.Nat]] @'[ '[1]] + (defined at T14343.hs:8:16) + +T14343.hs:12:9: error: + • Found hole: _ :: Proxy '[ '("Symbol", 1)] + • In the expression: _ :: Proxy '['("Symbol", 1)] + In an equation for ‘test3’: test3 = _ :: Proxy '['("Symbol", 1)] + • Relevant bindings include + test3 :: Proxy '[ '("Symbol", 1)] (bound at T14343.hs:12:1) + Valid hole fits include + test3 :: Proxy '[ '("Symbol", 1)] (defined at T14343.hs:12:1) + Proxy :: forall k1 (k2 :: k1). Proxy k2 + with Proxy @[(GHC.Types.Symbol, GHC.Types.Nat)] @'[ '("Symbol", 1)] + (defined at T14343.hs:8:16) diff --git a/testsuite/tests/printer/T14343b.hs b/testsuite/tests/printer/T14343b.hs new file mode 100644 index 0000000000..6596a7a486 --- /dev/null +++ b/testsuite/tests/printer/T14343b.hs @@ -0,0 +1,12 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE PolyKinds #-} +{-# OPTIONS_GHC -Werror=typed-holes #-} + +main :: IO () +main = undefined + +data Proxy k = Proxy + +test1 = _ :: Proxy '( 'True, 'False ) +test2 = _ :: Proxy '( '( 'True, 'False ), 'False ) +test3 = _ :: Proxy '( '[ 1 ], 'False ) diff --git a/testsuite/tests/printer/T14343b.stderr b/testsuite/tests/printer/T14343b.stderr new file mode 100644 index 0000000000..1954f9465a --- /dev/null +++ b/testsuite/tests/printer/T14343b.stderr @@ -0,0 +1,39 @@ + +T14343b.hs:10:9: error: + • Found hole: _ :: Proxy '( 'True, 'False) + • In the expression: _ :: Proxy '( 'True, 'False) + In an equation for ‘test1’: test1 = _ :: Proxy '( 'True, 'False) + • Relevant bindings include + test1 :: Proxy '( 'True, 'False) (bound at T14343b.hs:10:1) + Valid hole fits include + test1 :: Proxy '( 'True, 'False) (defined at T14343b.hs:10:1) + Proxy :: forall k1 (k2 :: k1). Proxy k2 + with Proxy @(Bool, Bool) @'( 'True, 'False) + (defined at T14343b.hs:8:16) + +T14343b.hs:11:9: error: + • Found hole: _ :: Proxy '( '( 'True, 'False), 'False) + • In the expression: _ :: Proxy '('( 'True, 'False), 'False) + In an equation for ‘test2’: + test2 = _ :: Proxy '('( 'True, 'False), 'False) + • Relevant bindings include + test2 :: Proxy '( '( 'True, 'False), 'False) + (bound at T14343b.hs:11:1) + Valid hole fits include + test2 :: Proxy '( '( 'True, 'False), 'False) + (defined at T14343b.hs:11:1) + Proxy :: forall k1 (k2 :: k1). Proxy k2 + with Proxy @((Bool, Bool), Bool) @'( '( 'True, 'False), 'False) + (defined at T14343b.hs:8:16) + +T14343b.hs:12:9: error: + • Found hole: _ :: Proxy '( '[1], 'False) + • In the expression: _ :: Proxy '('[1], 'False) + In an equation for ‘test3’: test3 = _ :: Proxy '('[1], 'False) + • Relevant bindings include + test3 :: Proxy '( '[1], 'False) (bound at T14343b.hs:12:1) + Valid hole fits include + test3 :: Proxy '( '[1], 'False) (defined at T14343b.hs:12:1) + Proxy :: forall k1 (k2 :: k1). Proxy k2 + with Proxy @([GHC.Types.Nat], Bool) @'( '[1], 'False) + (defined at T14343b.hs:8:16) diff --git a/testsuite/tests/printer/all.T b/testsuite/tests/printer/all.T index a71d6e3534..203efa4be4 100644 --- a/testsuite/tests/printer/all.T +++ b/testsuite/tests/printer/all.T @@ -50,3 +50,9 @@ test('T13199', ignore_stderr, run_command, ['$MAKE -s --no-print-directory T1319 test('T13050p', ignore_stderr, run_command, ['$MAKE -s --no-print-directory T13050p']) test('T13550', ignore_stderr, run_command, ['$MAKE -s --no-print-directory T13550']) test('T13942', ignore_stderr, run_command, ['$MAKE -s --no-print-directory T13942']) +test('T14289', ignore_stderr, run_command, ['$MAKE -s --no-print-directory T14289']) +test('T14289b', ignore_stderr, run_command, ['$MAKE -s --no-print-directory T14289b']) +test('T14289c', ignore_stderr, run_command, ['$MAKE -s --no-print-directory T14289c']) +test('T14306', ignore_stderr, run_command, ['$MAKE -s --no-print-directory T14306']) +test('T14343', normal, compile_fail, ['']) +test('T14343b', normal, compile_fail, ['']) diff --git a/testsuite/tests/profiling/should_compile/Makefile b/testsuite/tests/profiling/should_compile/Makefile index 9101fbd40a..012890aa9d 100644 --- a/testsuite/tests/profiling/should_compile/Makefile +++ b/testsuite/tests/profiling/should_compile/Makefile @@ -1,3 +1,8 @@ TOP=../../.. include $(TOP)/mk/boilerplate.mk include $(TOP)/mk/test.mk + +T14931: + "$(TEST_HC)" $(TEST_HC_OPTS) -v0 -c -O -static -dynamic-too -dynosuf dyn_o -dynhisuf dyn_hi T14931_State.hs + "$(TEST_HC)" $(TEST_HC_OPTS) -v0 -c -O -prof -osuf p_o -hisuf p_hi T14931_State.hs + "$(TEST_HC)" $(TEST_HC_OPTS) -v0 -c -O -prof -osuf p_o -hisuf p_hi T14931_Bug.hs diff --git a/testsuite/tests/profiling/should_compile/T12790.hs b/testsuite/tests/profiling/should_compile/T12790.hs new file mode 100644 index 0000000000..3c3f7d487e --- /dev/null +++ b/testsuite/tests/profiling/should_compile/T12790.hs @@ -0,0 +1,48 @@ +module T12790 (list) where + +import Data.Foldable (asum) +import Text.ParserCombinators.Parsec (Parser, sepBy, try) + +data Expr + = Var Fixity String + | App Expr Expr + +data Fixity = Pref | Inf + +cons, nil :: Expr +cons = Var Inf ":" +nil = Var Pref "[]" + +brackets :: Parser a -> Parser a +brackets = undefined + +symbol :: String -> Parser String +symbol = undefined + +list :: Parser Expr +list = asum (map (try . brackets) plist) where + plist = [ + foldr (\e1 e2 -> cons `App` e1 `App` e2) nil `fmap` + (myParser False `sepBy` symbol ","), + do e <- myParser False + _ <- symbol ".." + return $ Var Pref "enumFrom" `App` e, + do e <- myParser False + _ <- symbol "," + e' <- myParser False + _ <- symbol ".." + return $ Var Pref "enumFromThen" `App` e `App` e', + do e <- myParser False + _ <- symbol ".." + e' <- myParser False + return $ Var Pref "enumFromTo" `App` e `App` e', + do e <- myParser False + _ <- symbol "," + e' <- myParser False + _ <- symbol ".." + e'' <- myParser False + return $ Var Pref "enumFromThenTo" `App` e `App` e' `App` e'' + ] + +myParser :: Bool -> Parser Expr +myParser = undefined diff --git a/testsuite/tests/profiling/should_compile/T14931_Bug.hs b/testsuite/tests/profiling/should_compile/T14931_Bug.hs new file mode 100644 index 0000000000..4e6f2136a8 --- /dev/null +++ b/testsuite/tests/profiling/should_compile/T14931_Bug.hs @@ -0,0 +1,24 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE TemplateHaskell #-} +module T14931_Bug where + +import Prelude (Int, IO, Bool(..), Num(..), Monad(..), not, print) +import qualified Language.Haskell.TH.Syntax as TH +import T14931_State + +wat :: IO () +wat = print $(let playGame [] = do + (_, score) <- get + return score + playGame (x:xs) = do + (on, score) <- get + case x of + 'a' | on -> put (on, score + 1) + 'b' | on -> put (on, score - 1) + 'c' -> put (not on, score) + _ -> put (on, score) + playGame xs + + startState :: (Bool, Int) + startState = (False, 0) + in TH.lift (evalState (playGame "abcaaacbbcabbab") startState) ) diff --git a/testsuite/tests/profiling/should_compile/T14931_State.hs b/testsuite/tests/profiling/should_compile/T14931_State.hs new file mode 100644 index 0000000000..9008c06a96 --- /dev/null +++ b/testsuite/tests/profiling/should_compile/T14931_State.hs @@ -0,0 +1,15 @@ +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE FunctionalDependencies #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE UndecidableInstances #-} +module T14931_State (MonadState(..), Lazy.evalState) where + +import qualified Control.Monad.Trans.State.Lazy as Lazy (StateT, get, put, evalState) + +class Monad m => MonadState s m | m -> s where + get :: m s + put :: s -> m () + +instance Monad m => MonadState s (Lazy.StateT s m) where + get = Lazy.get + put = Lazy.put diff --git a/testsuite/tests/profiling/should_compile/T15108.hs b/testsuite/tests/profiling/should_compile/T15108.hs new file mode 100644 index 0000000000..d0143bf849 --- /dev/null +++ b/testsuite/tests/profiling/should_compile/T15108.hs @@ -0,0 +1,22 @@ +module Main where + +main :: IO () +main = do + _ <- return $ getInt Circle + return () + +newtype MyInt = MyInt Int + +data Shape = Circle | Square + +getInt :: Shape -> MyInt +getInt sh = + case sh of + Circle -> + let (MyInt i) = MyInt 3 + in myInt i + Square -> + let (MyInt i) = MyInt 2 + in myInt i + where + myInt = MyInt diff --git a/testsuite/tests/profiling/should_compile/T5889/A.hs b/testsuite/tests/profiling/should_compile/T5889/A.hs new file mode 100644 index 0000000000..98a2d703a6 --- /dev/null +++ b/testsuite/tests/profiling/should_compile/T5889/A.hs @@ -0,0 +1,7 @@ +import B + +-- See B.hs for an explanation on how this bug is triggered. + +-- This is a linker error, so we have to define a main and link +main :: IO () +main = putStrLn $ show $ bar 100 Nothing diff --git a/testsuite/tests/profiling/should_compile/T5889/B.hs b/testsuite/tests/profiling/should_compile/T5889/B.hs new file mode 100644 index 0000000000..fb998cc5e6 --- /dev/null +++ b/testsuite/tests/profiling/should_compile/T5889/B.hs @@ -0,0 +1,65 @@ +{-# OPTIONS_GHC -fprof-auto #-} +module B where + +plus_noinline :: Integer -> Integer -> Integer +plus_noinline x y = x + y +{-# NOINLINE plus_noinline #-} + +-- | This is the key function. We do not want this to be inlined into bar, but +-- we DO want it to be inlined into main (in A.hs). Moreover, when it is inlined +-- into main, we don't want the values inside the tuple to be inlined. To +-- achieve this, in main we call bar with Nothing allowing split to be inlined +-- with the first case, where the values in tuple are calls to NOINLINE +-- functions. +split :: Integer -> Maybe Integer -> (Integer, Integer) +split n Nothing = (n `plus_noinline` 1, n `plus_noinline` 2) +split n (Just m) = + if n == 0 then (m, m) else split (n - 1) (Just m) + + +{- | The simplified core for bar is: + +[GblId, + Arity=2, + Str=<L,U><S,1*U>, + Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, + Guidance=ALWAYS_IF(arity=2,unsat_ok=True,boring_ok=False) + Tmpl= \ (n_a1Gq [Occ=OnceL] :: Integer) + (m_a1Gr [Occ=OnceL] :: Maybe Integer) -> + scc<bar> + let { + ds_s2rg :: (Integer, Integer) + [LclId] + ds_s2rg = scc<bar.(...)> split n_a1Gq m_a1Gr } in + plus_noinline + (scc<bar.y> + case ds_s2rg of { (y_a2ps [Occ=Once], _ [Occ=Dead]) + -> y_a2ps }) + (scc<bar.z> + case ds_s2rg of { (_ [Occ=Dead], z_a2pu [Occ=Once]) + -> z_a2pu })}] +bar + = \ (n_a1Gq :: Integer) (m_a1Gr :: Maybe Integer) -> + scc<bar> + case scc<bar.(...)> split n_a1Gq m_a1Gr of + { (ww1_s2s7, ww2_s2s8) -> + plus_noinline ww1_s2s7 ww2_s2s8 + } + +Note that there are sccs around the (x,y) pattern match in the unfolding, but +not in the simplified function. See #5889 for a discussion on why the sccs are +present in one but not the other, and whether this is correct. + +split is not inlined here, because it is a recursive function. + +In A.hs, bar is called with m = Nothing, allowing split to be inlined (as it is +not recursive in that case) and the sccs ARE present in the simplified core of +main (as they are around function calls, not ids). This triggers the linker +error. + +-} +bar :: Integer -> Maybe Integer -> Integer +bar n m = y `plus_noinline` z + where + (y, z) = split n m diff --git a/testsuite/tests/profiling/should_compile/all.T b/testsuite/tests/profiling/should_compile/all.T index 45d0b3aefd..999fa538fd 100644 --- a/testsuite/tests/profiling/should_compile/all.T +++ b/testsuite/tests/profiling/should_compile/all.T @@ -1,8 +1,10 @@ - # We need to run prof001 and prof002 the normal way, as the extra flags # added for the profiling ways makes it pass test('prof001', [only_ways(['normal']), req_profiling], compile_and_run, ['-prof -fprof-cafs']) test('prof002', [only_ways(['normal']), req_profiling], compile_and_run, ['-prof -fprof-cafs']) test('T2410', [only_ways(['normal']), req_profiling], compile, ['-O2 -prof -fprof-cafs']) - +test('T5889', [only_ways(['normal']), req_profiling, extra_files(['T5889/A.hs', 'T5889/B.hs'])], multimod_compile, ['A B', '-O -prof -fno-prof-count-entries -v0']) +test('T12790', [only_ways(['normal']), req_profiling], compile, ['-O -prof']) +test('T14931', [only_ways(['normal']), req_profiling], run_command, ['$MAKE -s --no-print-directory T14931']) +test('T15108', [only_ways(['normal']), req_profiling], compile, ['-O -prof -fprof-auto']) diff --git a/testsuite/tests/profiling/should_run/Makefile b/testsuite/tests/profiling/should_run/Makefile index 9adb0a1b76..d52bda1918 100644 --- a/testsuite/tests/profiling/should_run/Makefile +++ b/testsuite/tests/profiling/should_run/Makefile @@ -4,25 +4,6 @@ include $(TOP)/mk/test.mk DECIMAL_REGEXP = [0-9]\+.[0-9]\+ -define scc001Test - grep -q '^ *$1 \+Main \+[0-9]\+ \+1 \+$(DECIMAL_REGEXP) \+$(DECIMAL_REGEXP) \+$(DECIMAL_REGEXP) \+$(DECIMAL_REGEXP)$$' scc001.prof || { echo 'No single-entry for $1 found in profile'; grep '^ *$1 ' scc001.prof; true; } -endef - -define scc001Rule - rm -f scc001.hi scc001.o scc001 - @echo Compiling with $1 - '$(TEST_HC)' $(TEST_HC_OPTS) -v0 --make scc001 -prof -fprof-auto -rtsopts $1 - ./scc001 +RTS -p - $(call scc001Test,f) - $(call scc001Test,g) - $(call scc001Test,h) -endef - -.PHONY: scc001 -scc001: - $(call scc001Rule,-O0) - $(call scc001Rule,-O) - .PHONY: T11489 T11489: $(RM) T11489 @@ -33,3 +14,11 @@ T11489: # then continue to run and exit normally. # Caused a segmentation fault in GHC <= 7.10.3 ./T11489 +RTS -hr{} -hc + +.PHONY: T14257 +T14257: + $(RM) T14257 + "$(TEST_HC)" -O2 --make -prof -v0 -fprof-auto T14257.hs + ./T14257 +RTS -hc + # Make sure that samples are monotonically increasing + awk 'BEGIN{t=0} /BEGIN_SAMPLE/{if ($$2 < t) print "uh oh", $$t, $$0; t=$$2;}' T14257.hp diff --git a/testsuite/tests/profiling/should_run/T12962.prof.sample b/testsuite/tests/profiling/should_run/T12962.prof.sample index 025e9e036c..228a92dbc3 100644 --- a/testsuite/tests/profiling/should_run/T12962.prof.sample +++ b/testsuite/tests/profiling/should_run/T12962.prof.sample @@ -11,9 +11,9 @@ MAIN MAIN <built-in> 0.0 1.2 CAF GHC.IO.Handle.FD <entire-module> 0.0 60.5 CAF GHC.IO.Encoding <entire-module> 0.0 4.8 CAF GHC.Conc.Signal <entire-module> 0.0 1.1 -foo Main T12962.hs:8:1-21 0.0 2.8 -niz3 Main T12962.hs:12:1-27 0.0 20.9 -blah Main T12962.hs:15:1-22 0.0 8.3 +foo Main T12962.hs:12:1-21 0.0 2.8 +niz3 Main T12962.hs:16:1-27 0.0 20.9 +blah Main T12962.hs:19:1-22 0.0 8.3 individual inherited @@ -21,12 +21,12 @@ COST CENTRE MODULE SRC no. entries %time %all MAIN MAIN <built-in> 110 0 0.0 1.2 0.0 100.0 CAF Main <entire-module> 219 0 0.0 0.0 0.0 32.1 - blah Main T12962.hs:15:1-22 223 1 0.0 8.3 0.0 8.3 - main Main T12962.hs:17:1-47 220 1 0.0 0.0 0.0 23.8 - niz3 Main T12962.hs:12:1-27 222 1 0.0 20.9 0.0 23.7 - foo Main T12962.hs:8:1-21 224 100 0.0 2.8 0.0 2.8 + blah Main T12962.hs:19:1-22 223 1 0.0 8.3 0.0 8.3 + main Main T12962.hs:21:1-47 220 1 0.0 0.0 0.0 23.8 + niz3 Main T12962.hs:16:1-27 222 1 0.0 20.9 0.0 23.7 + foo Main T12962.hs:12:1-21 224 100 0.0 2.8 0.0 2.8 CAF GHC.Conc.Signal <entire-module> 214 0 0.0 1.1 0.0 1.1 CAF GHC.IO.Encoding <entire-module> 204 0 0.0 4.8 0.0 4.8 CAF GHC.IO.Encoding.Iconv <entire-module> 202 0 0.0 0.3 0.0 0.3 CAF GHC.IO.Handle.FD <entire-module> 194 0 0.0 60.5 0.0 60.5 - main Main T12962.hs:17:1-47 221 0 0.0 0.0 0.0 0.0 + main Main T12962.hs:21:1-47 221 0 0.0 0.0 0.0 0.0 diff --git a/testsuite/tests/profiling/should_run/T14257.hs b/testsuite/tests/profiling/should_run/T14257.hs new file mode 100644 index 0000000000..af67239cb6 --- /dev/null +++ b/testsuite/tests/profiling/should_run/T14257.hs @@ -0,0 +1,16 @@ +{-# LANGUAGE ScopedTypeVariables #-} +module Main where + +eval :: forall a b. (a -> b -> b) -> b -> [a] -> b +eval f b xs = load xs [] + where + load :: [a] -> [a] -> b + load [] stk = unload b stk + load (x:xs) stk = load xs (x : stk) + + unload :: b -> [a] -> b + unload v [] = v + unload v (x : stk) = unload ((f $! x) $! v) stk + +main :: IO () +main = print (eval (||) False (True : replicate 10000000 False)) diff --git a/testsuite/tests/profiling/should_run/T14257.stdout b/testsuite/tests/profiling/should_run/T14257.stdout new file mode 100644 index 0000000000..0ca95142bb --- /dev/null +++ b/testsuite/tests/profiling/should_run/T14257.stdout @@ -0,0 +1 @@ +True diff --git a/testsuite/tests/profiling/should_run/T3001-2.hs b/testsuite/tests/profiling/should_run/T3001-2.hs index 5a84dcc69d..17fa0c9c48 100644 --- a/testsuite/tests/profiling/should_run/T3001-2.hs +++ b/testsuite/tests/profiling/should_run/T3001-2.hs @@ -7,7 +7,7 @@ module Main (main) where -import Data.Monoid +import Data.Semigroup import Data.ByteString.Internal (inlinePerformIO) @@ -284,6 +284,9 @@ flush = Builder $ \ k buf@(Buffer p o u l) -> emptyBuilder :: Builder emptyBuilder = Builder id +instance Semigroup Builder where + (<>) = append + instance Monoid Builder where mempty = emptyBuilder mappend = append diff --git a/testsuite/tests/profiling/should_run/all.T b/testsuite/tests/profiling/should_run/all.T index 530d2fcbaf..8d605f2da2 100644 --- a/testsuite/tests/profiling/should_run/all.T +++ b/testsuite/tests/profiling/should_run/all.T @@ -33,12 +33,15 @@ test('T2592', test('T3001', [only_ways(['prof_hb']), extra_ways(['prof_hb'])], compile_and_run, ['']) -test('T3001-2', [only_ways(['prof_hb']), extra_ways(['prof_hb'])], +test('T3001-2', + [only_ways(['prof_hb']), extra_ways(['prof_hb'])], compile_and_run, ['-package bytestring']) -# As with ioprof001, the unoptimised profile is different but -# not badly wrong (CAF attribution is different). -test('scc001', expect_broken_for_10037, compile_and_run, +# For profasm/profthreaded, the answer is correct but the ordering of some +# lines in the output happen to be different, so we just skip them. +test('scc001', + omit_ways(['profasm', 'profthreaded']), + compile_and_run, ['-fno-state-hack -fno-full-laziness']) # Note [consistent stacks] test('scc002', [], compile_and_run, ['']) @@ -110,10 +113,16 @@ test('T5363', [], compile_and_run, ['']) test('profinline001', [], compile_and_run, ['']) -test('T11627a', [extra_ways(extra_prof_ways)], compile_and_run, ['']) +# Skip T11627a and T11627b on Darwin as it tends to give us a very small stack +# which the retainer profiler tends to overflow. See #15287 and #11627. +test('T11627a', [ extra_ways(extra_prof_ways) + , when(opsys('darwin'), skip) + ], + compile_and_run, ['']) test('T11627b', [ extra_run_opts('+RTS -i0 -RTS') # census after each GC , extra_ways(extra_prof_ways) + , when(opsys('darwin'), skip) , when(opsys('mingw32'), expect_broken_for(12236, ['prof_hc_hb'])) ] @@ -132,3 +141,5 @@ test('toplevel_scc_1', ['']) test('T12962', [], compile_and_run, ['']) + +test('T14257', [], run_command, ['$MAKE -s --no-print-directory T14257']) diff --git a/testsuite/tests/profiling/should_run/scc001.prof.sample b/testsuite/tests/profiling/should_run/scc001.prof.sample index f2e55d55d5..8b33d6b94b 100644 --- a/testsuite/tests/profiling/should_run/scc001.prof.sample +++ b/testsuite/tests/profiling/should_run/scc001.prof.sample @@ -21,9 +21,9 @@ MAIN MAIN <built-in> 111 0 0.0 CAF Main <entire-module> 221 0 0.0 0.0 0.0 0.6 (...) Main scc001.hs:16:1-16 227 1 0.0 0.0 0.0 0.0 main Main scc001.hs:(5,1)-(7,23) 222 1 0.0 0.5 0.0 0.5 + h Main scc001.hs:16:1-16 226 1 0.0 0.0 0.0 0.0 f Main scc001.hs:10:1-7 224 1 0.0 0.0 0.0 0.0 g Main scc001.hs:13:1-7 225 1 0.0 0.0 0.0 0.0 - h Main scc001.hs:16:1-16 226 1 0.0 0.0 0.0 0.0 CAF GHC.Conc.Signal <entire-module> 216 0 0.0 1.3 0.0 1.3 CAF GHC.IO.Encoding <entire-module> 206 0 0.0 5.4 0.0 5.4 CAF GHC.IO.Encoding.Iconv <entire-module> 204 0 0.0 0.4 0.0 0.4 diff --git a/testsuite/tests/profiling/should_run/scc003.prof.sample b/testsuite/tests/profiling/should_run/scc003.prof.sample index c8090130fa..d65b8752ea 100644 --- a/testsuite/tests/profiling/should_run/scc003.prof.sample +++ b/testsuite/tests/profiling/should_run/scc003.prof.sample @@ -22,10 +22,10 @@ MAIN MAIN <built-in> 104 0 0.0 1.9 CAF Main <entire-module> 207 0 0.0 0.0 100.0 0.7 main Main scc003.hs:2:1-22 208 1 0.0 0.6 100.0 0.7 f Main scc003.hs:5:1-41 210 1 0.0 0.0 100.0 0.1 - f.(...) Main scc003.hs:5:11-21 211 1 0.0 0.0 0.0 0.0 - fib Main scc003.hs:8:1-50 212 21891 0.0 0.0 0.0 0.0 f.\ Main scc003.hs:5:32-41 213 1 0.0 0.0 100.0 0.0 fib Main scc003.hs:8:1-50 214 2692537 100.0 0.0 100.0 0.0 + f.x' Main scc003.hs:5:11-21 211 1 0.0 0.0 0.0 0.0 + fib Main scc003.hs:8:1-50 212 21891 0.0 0.0 0.0 0.0 CAF GHC.Conc.Signal <entire-module> 201 0 0.0 1.3 0.0 1.3 CAF GHC.IO.Encoding <entire-module> 191 0 0.0 5.7 0.0 5.7 CAF GHC.IO.Encoding.Iconv <entire-module> 189 0 0.0 0.5 0.0 0.5 diff --git a/testsuite/tests/programs/andy_cherry/Interp.hs b/testsuite/tests/programs/andy_cherry/Interp.hs index 7d33e896cf..e323dc34f7 100644 --- a/testsuite/tests/programs/andy_cherry/Interp.hs +++ b/testsuite/tests/programs/andy_cherry/Interp.hs @@ -94,7 +94,7 @@ getCurrColour `thenP` \ col -> let invert Black r = r -- because the move has *already* happend - invert _ "0.00" = "0.00" -- dont negate 0 + invert _ "0.00" = "0.00" -- don't negate 0 invert _ ('-':r) = r invert _ r = '-':r in diff --git a/testsuite/tests/programs/andy_cherry/andy_cherry.stdout b/testsuite/tests/programs/andy_cherry/andy_cherry.stdout index 8cb61fe7b3..743174dce8 100644 --- a/testsuite/tests/programs/andy_cherry/andy_cherry.stdout +++ b/testsuite/tests/programs/andy_cherry/andy_cherry.stdout @@ -67,7 +67,7 @@ $$\showboard$$ 6 & N*e4?&\\ \end{tabular}}| \end{center} -Taking this knight looses a pawn +Taking this knight loses a pawn \begin{center}| {\bf\begin{tabular}{rp{50pt}p{50pt}} 6 & \ldots & d*e4\\ @@ -4764,7 +4764,7 @@ Edinburgh Congress 25 & h3&\\ \end{tabular}}| \end{center} -At this point the score sheet goes wrong. Black eventually looses on +At this point the score sheet goes wrong. Black eventually loses on time! \board @@ -7076,7 +7076,7 @@ white scored a decisive victory. \end{tabular}}| \end{center} |13.~h3, Bh5; 14.~Nbd2, Rfd8; 15.~Nb3, Qd6; 16.~Qe2, Rab8; 17.~Red1| -Fritz is deperate to put h3, but I dont see why. +Fritz is desperate to put h3, but I don't see why. \begin{center}| {\bf\begin{tabular}{rp{50pt}p{50pt}} 13 & \ldots & Nh5\\ diff --git a/testsuite/tests/programs/andy_cherry/mygames.pgn b/testsuite/tests/programs/andy_cherry/mygames.pgn index 742e03bbc9..9a338cf05e 100644 --- a/testsuite/tests/programs/andy_cherry/mygames.pgn +++ b/testsuite/tests/programs/andy_cherry/mygames.pgn @@ -13,7 +13,7 @@ 1. Nf3 d5 2. d4 Nc6 3. Nc3 Nf6 (3... Bf5 {is more natural.}) 4. e4? ( 4. Bf4 {is better.}) 4... e6? (4... dxe4 5. d5 exf3 6. dxc6 Qxd1+ 7. Nxd1 {and black is a clear pawn up.}) 5. e5 Ne4 {} 6. Nxe4? { Taking -this knight looses a pawn} 6... dxe4 7. Nd2 Qxd4 8. Nc4 Qxd1+ 9. Kxd1 +this knight loses a pawn} 6... dxe4 7. Nd2 Qxd4 8. Nc4 Qxd1+ 9. Kxd1 Bd7 (9... Bc5 10. f3 exf3 11. gxf3 O-O 12. Bd3 {White can get presure down the `g' file, but first needs to solve the problem of the Bishop on c5 guarding g8.}) 10. Bd2 (10. Be3 {is better.}) 10... Bb4 11. c3 Bc5 12. @@ -890,7 +890,7 @@ Nf3 Rb2 36. h4 d2 37. Nxd2 Rxd2 38. Kg4 Rd3 39. Rxd3 Bxd3 40. Kf3 Bc4 14. Re1 h6 15. Bxe7 Qxe7 16. exf5 Qf6 17. Be4 Bb7 18. Bxb7 Nxb7 19. Qb3+ Kh8 20. Qd5 Rab8 21. Rac1 Bb6 22. g4 Nd8 23. Ne4 Qf7 24. Qxf7 Rxf7 25. h3 {At this point the score sheet goes wrong. Black eventually -looses on time!} 1-0 +loses on time!} 1-0 [Site "Edinburgh Congress"] [Date "1994.04.??"] @@ -1299,7 +1299,7 @@ like Game 7 of the Short-Kasparov WC, where Kasparov as white scored a decisive victory.}) 8... Bg4 9. d3 h6 10. Be3 O-O (10... Bxe3 11. Rxe3 O-O 12. a4 b4 13. h3 Bh5 14. Nbd2 Rb8 {=}) 11. Bxc5 dxc5 12. Bc2 Qd7 13. Nbd2 (13. h3 Bh5 14. Nbd2 Rfd8 15. Nb3 Qd6 16. Qe2 Rab8 17. Red1 { -Fritz is deperate to put h3, but I dont see why.}) 13... Nh5 {} (13... +Fritz is desperate to put h3, but I don't see why.}) 13... Nh5 {} (13... Rad8 {is an idea.}) 14. Nb3 (14. h3 {<saw>,0.33 I now agree with this, because the knight block the h5 retreat square.}) 14... Nf4 {?} (14... Qd6 15. h3 Be6 16. Ng5 Bxb3 17. axb3 Nf4 18. Nf3 {<sab>}) 15. Nxc5 Qc8 ( diff --git a/testsuite/tests/programs/galois_raytrace/Eval.hs b/testsuite/tests/programs/galois_raytrace/Eval.hs index bf43d10605..001842edad 100644 --- a/testsuite/tests/programs/galois_raytrace/Eval.hs +++ b/testsuite/tests/programs/galois_raytrace/Eval.hs @@ -243,7 +243,7 @@ doPrimOp primOp op args show op ++ " takes " ++ show (length types) ++ " argument" ++ s ++ " with" ++ the ++ " type" ++ s ++ "\n|\n|" ++ " " ++ unwords [ show ty | ty <- types ] ++ "\n|\n|" ++ - " currently, the relevent argument" ++ s ++ " on the stack " ++ + " currently, the relevant argument" ++ s ++ " on the stack " ++ are ++ "\n|\n| " ++ unwords [ "(" ++ show arg ++ ")" | arg <- reverse (take (length types) args) ] ++ "\n|\n| " diff --git a/testsuite/tests/programs/galois_raytrace/Geometry.hs b/testsuite/tests/programs/galois_raytrace/Geometry.hs index 8bca3a3e89..3c00f7b233 100644 --- a/testsuite/tests/programs/galois_raytrace/Geometry.hs +++ b/testsuite/tests/programs/galois_raytrace/Geometry.hs @@ -293,7 +293,7 @@ offsetToPoint (r,v) i = r `addPV` (i `multSV` v) -- -epsilon, inf :: Double -- aproximate zero and infinity +epsilon, inf :: Double -- approximate zero and infinity epsilon = 1.0e-10 inf = 1.0e20 diff --git a/testsuite/tests/programs/galois_raytrace/test.T b/testsuite/tests/programs/galois_raytrace/test.T index 6f65800cb2..743cbbfbe8 100644 --- a/testsuite/tests/programs/galois_raytrace/test.T +++ b/testsuite/tests/programs/galois_raytrace/test.T @@ -4,5 +4,5 @@ if config.platform.startswith('i386-') and \ setTestOpts(expect_fail_for(['hpc','optasm','profasm','threaded2','profthreaded'])) test('galois_raytrace', [extra_files(['CSG.hs', 'Construct.hs', 'Data.hs', 'Eval.hs', 'Geometry.hs', 'Illumination.hs', 'Intersections.hs', 'Interval.hs', 'Main.hs', 'Misc.hs', 'Parse.hs', 'Primitives.hs', 'Surface.hs', 'galois.gml']), - when(fast(), skip), reqlib('parsec')], + when(fast(), skip)], multimod_compile_and_run, ['Main', '-package parsec']) diff --git a/testsuite/tests/programs/maessen-hashtab/Data/HashTab.hs b/testsuite/tests/programs/maessen-hashtab/Data/HashTab.hs index e96d5c5efa..85b3046db9 100644 --- a/testsuite/tests/programs/maessen-hashtab/Data/HashTab.hs +++ b/testsuite/tests/programs/maessen-hashtab/Data/HashTab.hs @@ -171,7 +171,7 @@ new cmpr hash = do -- ----------------------------------------------------------------------------- -- Inserting a key\/value pair into the hash table --- | Inserts an key\/value mapping into the hash table. +-- | Inserts a key\/value mapping into the hash table. -- -- Note that 'insert' doesn't remove the old entry from the table - -- the behaviour is like an association list, where 'lookup' returns diff --git a/testsuite/tests/semigroup/Makefile b/testsuite/tests/quantified-constraints/Makefile index 9a36a1c5fe..9a36a1c5fe 100644 --- a/testsuite/tests/semigroup/Makefile +++ b/testsuite/tests/quantified-constraints/Makefile diff --git a/testsuite/tests/quantified-constraints/T14833.hs b/testsuite/tests/quantified-constraints/T14833.hs new file mode 100644 index 0000000000..43b6491def --- /dev/null +++ b/testsuite/tests/quantified-constraints/T14833.hs @@ -0,0 +1,28 @@ +{-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE QuantifiedConstraints #-} +{-# LANGUAGE UndecidableInstances #-} +module T14833 where + +data Dict c where + Dict :: c => Dict c + +class (a => b) => Implies a b +instance (a => b) => Implies a b + +-- Works ok +iota1 :: (() => a) => Dict a +iota1 = Dict + +iota2 :: Implies () a => Dict a +iota2 = Dict + +{- +[G] Implies () a +[G] (() => a) -- By superclass + +[W] a +-} diff --git a/testsuite/tests/quantified-constraints/T14835.hs b/testsuite/tests/quantified-constraints/T14835.hs new file mode 100644 index 0000000000..de9b450b7c --- /dev/null +++ b/testsuite/tests/quantified-constraints/T14835.hs @@ -0,0 +1,20 @@ +{-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE QuantifiedConstraints #-} +{-# LANGUAGE UndecidableInstances #-} +module Bug where + +data Dict c where + Dict :: c => Dict c + +class (a => b) => Implies a b +instance (a => b) => Implies a b + +curryC1 :: ((a, b) => c) => Dict (Implies a (Implies b c)) +curryC1 = Dict + +curryC2 :: Implies (a, b) c => Dict (Implies a (Implies b c)) +curryC2 = Dict diff --git a/testsuite/tests/quantified-constraints/T14863.hs b/testsuite/tests/quantified-constraints/T14863.hs new file mode 100644 index 0000000000..35e1a14b42 --- /dev/null +++ b/testsuite/tests/quantified-constraints/T14863.hs @@ -0,0 +1,27 @@ +{-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE ImpredicativeTypes #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE QuantifiedConstraints #-} +{-# LANGUAGE UndecidableInstances #-} +module T14863 where + +data Dict c where + Dict :: c => Dict c + +class (a => b) => Implies a b +instance (a => b) => Implies a b + +uncurryCImpredic1 :: forall a b c. Implies a (b => c) => Dict (Implies (a, b) c) +uncurryCImpredic1 = Dict + +uncurryCImpredic2 :: forall a b c. a => Implies b c => Dict (Implies (a, b) c) +uncurryCImpredic2 = Dict + +uncurryC1 :: forall a b c. (a => b => c) => Dict (Implies (a, b) c) +uncurryC1 = Dict + +uncurryC2 :: forall a b c. Implies a (Implies b c) => Dict (Implies (a, b) c) +uncurryC2 = Dict diff --git a/testsuite/tests/quantified-constraints/T14961.hs b/testsuite/tests/quantified-constraints/T14961.hs new file mode 100644 index 0000000000..6f15ceb572 --- /dev/null +++ b/testsuite/tests/quantified-constraints/T14961.hs @@ -0,0 +1,98 @@ +{-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE InstanceSigs #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeFamilyDependencies #-} +{-# LANGUAGE TypeInType #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE QuantifiedConstraints #-} + +module T14961 where + +import Data.Kind + +import Control.Arrow (left, right, (&&&), (|||)) +import Control.Category +import Prelude hiding (id, (.)) + +import Data.Coerce + +class (forall x. f x => g x) => f ~=> g +instance (forall x. f x => g x) => f ~=> g + +type family (#) (p :: Type -> Type -> Type) (ab :: (Type, Type)) + = (r :: Type) | r -> p ab where + p # '(a, b) = p a b + +newtype Glass + :: ((Type -> Type -> Type) -> Constraint) + -> (Type, Type) -> (Type, Type) -> Type where + Glass :: (forall p. z p => p # ab -> p # st) -> Glass z st ab + +data A_Prism + +type family ConstraintOf (tag :: Type) + = (r :: (Type -> Type -> Type) -> Constraint) where + ConstraintOf A_Prism = Choice + +_Left0 + :: Glass Choice + '(Either a x, Either b x) + '(a, b) +_Left0 = Glass left' + +_Left1 + :: c ~=> Choice + => Glass c '(Either a x, Either b x) '(a, b) +_Left1 = Glass left' + +-- fails with +-- • Could not deduce (Choice p) +-- _Left2 +-- :: (forall p. c p => ConstraintOf A_Prism p) +-- => Glass c '(Either a x, Either b x) '(a, b) +-- _Left2 = Glass left' + +_Left3 + :: d ~ ConstraintOf A_Prism + => (forall p . c p => d p) + => Glass c + '(Either a x, Either b x) + '(a, b) +_Left3 = Glass left' + +-- fails to typecheck unless at least a partial type signature is provided +-- l :: c ~=> Choice => Glass c _ _ +-- l = _Left1 . _Left1 + +newtype Optic o st ab where + Optic + :: (forall c d. (d ~ ConstraintOf o, c ~=> d) => Glass c st ab) + -> Optic o st ab + +_Left + :: Optic A_Prism + '(Either a x, Either b x) + '(a, b) +_Left = Optic _Left1 + +instance Category (Glass z) where + id :: Glass z a a + id = Glass id + + (.) :: Glass z uv ab -> Glass z st uv -> Glass z st ab + Glass abuv . Glass uvst = Glass (uvst . abuv) + +class Profunctor (p :: Type -> Type -> Type) where + dimap :: (a -> b) -> (c -> d) -> p b c -> p a d + lmap :: (a -> b) -> p b c -> p a c + rmap :: (b -> c) -> p a b -> p a c + +class Profunctor p => Choice (p :: Type -> Type -> Type) where + left' :: p a b -> p (Either a c) (Either b c) + right' :: p a b -> p (Either c a) (Either c b) diff --git a/testsuite/tests/quantified-constraints/T15231.hs b/testsuite/tests/quantified-constraints/T15231.hs new file mode 100644 index 0000000000..7b7834d1f2 --- /dev/null +++ b/testsuite/tests/quantified-constraints/T15231.hs @@ -0,0 +1,15 @@ +{-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE QuantifiedConstraints #-} +module Bug where + +import Data.Kind + +data ECC :: Constraint -> Type -> Type + +class Y a +class Z a + +instance c => Y (ECC c a) +instance (c => Z a) => Z (ECC c a) diff --git a/testsuite/tests/quantified-constraints/T15231.stderr b/testsuite/tests/quantified-constraints/T15231.stderr new file mode 100644 index 0000000000..afb7ac3a25 --- /dev/null +++ b/testsuite/tests/quantified-constraints/T15231.stderr @@ -0,0 +1,7 @@ + +T15231.hs:15:10: error: + • Variable ‘c’ occurs more often + in the constraint ‘c’ than in the instance head ‘Z a’ + (Use UndecidableInstances to permit this) + • In the quantified constraint ‘c => Z a’ + In the instance declaration for ‘Z (ECC c a)’ diff --git a/testsuite/tests/quantified-constraints/T15244.hs b/testsuite/tests/quantified-constraints/T15244.hs new file mode 100644 index 0000000000..16d2b65d53 --- /dev/null +++ b/testsuite/tests/quantified-constraints/T15244.hs @@ -0,0 +1,69 @@ +{-# LANGUAGE QuantifiedConstraints, TypeFamilies #-} + +module T15244 where +class (forall t . Eq (c t)) => Blah c + +-- Unquantified works +foo :: (Eq (a t), Eq (b t), a ~ b) => a t -> b t -> Bool +foo a b = a == b +-- Works + +-- Two quantified instances fail with double ambiguity check errors +bar :: (forall t . Eq (a t), forall t . Eq (b t), a ~ b) => a t -> b t -> Bool +bar a b = a == b +-- Minimal.hs:11:8: error: +-- • Could not deduce (Eq (b t1)) +-- from the context: (forall t1. Eq (a t1), forall t1. Eq (b t1), +-- a ~ b) +-- bound by the type signature for: +-- bar :: forall (a :: * -> *) (b :: * -> *) t. +-- (forall t1. Eq (a t1), forall t1. Eq (b t1), a ~ b) => +-- a t -> b t -> Bool +-- at Minimal.hs:11:8-78 +-- • In the ambiguity check for ‘bar’ +-- To defer the ambiguity check to use sites, enable AllowAmbiguousTypes +-- In the type signature: +-- bar :: (forall t. Eq (a t), forall t. Eq (b t), a ~ b) => +-- a t -> b t -> Bool +-- | +-- 11 | bar :: (forall t . Eq (a t), forall t . Eq (b t), a ~ b) => a t -> b t -> Bool +-- | +-- [And then another copy of the same error] + +-- Two copies from superclass instances fail +baz :: (Blah a, Blah b, a ~ b) => a t -> b t -> Bool +baz a b = a == b +-- Minimal.hs:34:11: error: +-- • Could not deduce (Eq (b t)) arising from a use of ‘==’ +-- from the context: (Blah a, Blah b, a ~ b) +-- bound by the type signature for: +-- baz :: forall (a :: * -> *) (b :: * -> *) t. +-- (Blah a, Blah b, a ~ b) => +-- a t -> b t -> Bool +-- at Minimal.hs:33:1-52 +-- • In the expression: a == b +-- In an equation for ‘baz’: baz a b = a == b +-- | +-- 34 | baz a b = a == b +-- | + +-- Two copies from superclass from same declaration also fail +mugga :: (Blah a, Blah a) => a t -> a t -> Bool +mugga a b = a == b +-- • Could not deduce (Eq (a t)) arising from a use of ‘==’ +-- from the context: (Blah a, Blah a) +-- bound by the type signature for: +-- mugga :: forall (a :: * -> *) t. +-- (Blah a, Blah a) => +-- a t -> a t -> Bool +-- at Minimal.hs:50:1-47 +-- • In the expression: a == b +-- In an equation for ‘mugga’: mugga a b = a == b +-- | +-- 51 | mugga a b = a == b +-- | + +-- One copy works +quux :: (Blah a, a ~ b) => a t -> b t -> Bool +quux a b = a == b +-- Works diff --git a/testsuite/tests/quantified-constraints/T15290.hs b/testsuite/tests/quantified-constraints/T15290.hs new file mode 100644 index 0000000000..8a0c3d989f --- /dev/null +++ b/testsuite/tests/quantified-constraints/T15290.hs @@ -0,0 +1,35 @@ +{-# LANGUAGE TypeApplications, ImpredicativeTypes, ScopedTypeVariables, + QuantifiedConstraints, StandaloneDeriving, GeneralizedNewtypeDeriving #-} + +module T15290 where + +import Prelude hiding ( Monad(..) ) +import Data.Coerce ( Coercible, coerce ) + +class Monad m where + join :: m (m a) -> m a + +newtype StateT s m a = StateT { runStateT :: s -> m (s, a) } + +newtype IntStateT m a = IntStateT { runIntStateT :: StateT Int m a } + +instance Monad m => Monad (StateT s m) where + join = error "urk" + +instance (Monad m, forall p q. Coercible p q => Coercible (m p) (m q)) + => Monad (IntStateT m) where + +-- Fails with the impredicative instantiation of coerce, succeeds without + +-- Impredicative version (fails) +-- join = coerce +-- @(forall a. StateT Int m (StateT Int m a) -> StateT Int m a) +-- @(forall a. IntStateT m (IntStateT m a) -> IntStateT m a) +-- join + + +-- Predicative version (succeeds) + join = (coerce + @(StateT Int m (StateT Int m a) -> StateT Int m a) + @(IntStateT m (IntStateT m a) -> IntStateT m a) + join) :: forall a. IntStateT m (IntStateT m a) -> IntStateT m a diff --git a/testsuite/tests/quantified-constraints/T15290a.hs b/testsuite/tests/quantified-constraints/T15290a.hs new file mode 100644 index 0000000000..bfb5b2a069 --- /dev/null +++ b/testsuite/tests/quantified-constraints/T15290a.hs @@ -0,0 +1,35 @@ +{-# LANGUAGE TypeApplications, ImpredicativeTypes, ScopedTypeVariables, + QuantifiedConstraints, StandaloneDeriving, GeneralizedNewtypeDeriving #-} + +module T15290a where + +import Prelude hiding ( Monad(..) ) +import Data.Coerce ( Coercible, coerce ) + +class Monad m where + join :: m (m a) -> m a + +newtype StateT s m a = StateT { runStateT :: s -> m (s, a) } + +newtype IntStateT m a = IntStateT { runIntStateT :: StateT Int m a } + +instance Monad m => Monad (StateT s m) where + join = error "urk" + +instance (Monad m, forall p q. Coercible p q => Coercible (m p) (m q)) + => Monad (IntStateT m) where + +-- Fails with the impredicative instantiation of coerce, succeeds without + +-- Impredicative version (fails) + join = coerce + @(forall a. StateT Int m (StateT Int m a) -> StateT Int m a) + @(forall a. IntStateT m (IntStateT m a) -> IntStateT m a) + join + + +-- Predicative version (succeeds) +-- join = (coerce +-- @(StateT Int m (StateT Int m a) -> StateT Int m a) +-- @(IntStateT m (IntStateT m a) -> IntStateT m a) +-- join) :: forall a. IntStateT m (IntStateT m a) -> IntStateT m a diff --git a/testsuite/tests/quantified-constraints/T15290a.stderr b/testsuite/tests/quantified-constraints/T15290a.stderr new file mode 100644 index 0000000000..2efd784f31 --- /dev/null +++ b/testsuite/tests/quantified-constraints/T15290a.stderr @@ -0,0 +1,22 @@ + +T15290a.hs:25:12: error: + • Couldn't match representation of type ‘m (Int, IntStateT m a1)’ + with that of ‘m (Int, StateT Int m a1)’ + arising from a use of ‘coerce’ + NB: We cannot know what roles the parameters to ‘m’ have; + we must assume that the role is nominal + • In the expression: + coerce + @(forall a. StateT Int m (StateT Int m a) -> StateT Int m a) + @(forall a. IntStateT m (IntStateT m a) -> IntStateT m a) + join + In an equation for ‘join’: + join + = coerce + @(forall a. StateT Int m (StateT Int m a) -> StateT Int m a) + @(forall a. IntStateT m (IntStateT m a) -> IntStateT m a) + join + In the instance declaration for ‘Monad (IntStateT m)’ + • Relevant bindings include + join :: IntStateT m (IntStateT m a) -> IntStateT m a + (bound at T15290a.hs:25:5) diff --git a/testsuite/tests/quantified-constraints/T15290b.hs b/testsuite/tests/quantified-constraints/T15290b.hs new file mode 100644 index 0000000000..ce99aa9454 --- /dev/null +++ b/testsuite/tests/quantified-constraints/T15290b.hs @@ -0,0 +1,28 @@ +{-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE ImpredicativeTypes #-} +{-# LANGUAGE InstanceSigs #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE QuantifiedConstraints #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} +module T15290b where + +import Data.Coerce +import Data.Kind + +type Representational1 m = (forall a b. Coercible a b => Coercible (m a) (m b) :: Constraint) + +class Representational1 f => Functor' f where + fmap' :: (a -> b) -> f a -> f b + +class Functor' f => Applicative' f where + pure' :: a -> f a + (<*>@) :: f (a -> b) -> f a -> f b + +class Functor' t => Traversable' t where + traverse' :: Applicative' f => (a -> f b) -> t a -> f (t b) + +-- Typechecks +newtype T1 m a = MkT1 (m a) deriving (Functor', Traversable') diff --git a/testsuite/tests/quantified-constraints/T15290b.stderr b/testsuite/tests/quantified-constraints/T15290b.stderr new file mode 100644 index 0000000000..7dc1852c6d --- /dev/null +++ b/testsuite/tests/quantified-constraints/T15290b.stderr @@ -0,0 +1,14 @@ + +T15290b.hs:28:49: error: + • Couldn't match representation of type ‘f (m b)’ + with that of ‘f (T1 m b)’ + arising from the coercion of the method ‘traverse'’ + from type ‘forall (f :: * -> *) a b. + Applicative' f => + (a -> f b) -> m a -> f (m b)’ + to type ‘forall (f :: * -> *) a b. + Applicative' f => + (a -> f b) -> T1 m a -> f (T1 m b)’ + NB: We cannot know what roles the parameters to ‘f’ have; + we must assume that the role is nominal + • When deriving the instance for (Traversable' (T1 m)) diff --git a/testsuite/tests/quantified-constraints/T15316.hs b/testsuite/tests/quantified-constraints/T15316.hs new file mode 100644 index 0000000000..07539e3183 --- /dev/null +++ b/testsuite/tests/quantified-constraints/T15316.hs @@ -0,0 +1,21 @@ +{-# LANGUAGE RankNTypes, QuantifiedConstraints, ConstraintKinds #-} +-- NB: disabling these if enabled: +{-# LANGUAGE NoUndecidableInstances, NoUndecidableSuperClasses #-} + +module T15316 where + +import Data.Proxy + +{- +class Class a where + method :: a + +subsume :: (Class a => Class b) => Proxy a -> Proxy b -> ((Class a => Class b) => r) -> r +subsume _ _ x = x + +value :: Proxy a -> a +value p = subsume p p method +-} + +subsume' :: Proxy c -> ((c => c) => r) -> r +subsume' _ x = x diff --git a/testsuite/tests/quantified-constraints/T15316.stderr b/testsuite/tests/quantified-constraints/T15316.stderr new file mode 100644 index 0000000000..4444c2c453 --- /dev/null +++ b/testsuite/tests/quantified-constraints/T15316.stderr @@ -0,0 +1,6 @@ + +T15316.hs:20:13: error: + • The constraint ‘c’ is no smaller than the instance head ‘c’ + (Use UndecidableInstances to permit this) + • In the quantified constraint ‘c => c’ + In the type signature: subsume' :: Proxy c -> ((c => c) => r) -> r diff --git a/testsuite/tests/quantified-constraints/T15334.hs b/testsuite/tests/quantified-constraints/T15334.hs new file mode 100644 index 0000000000..88d7c3f376 --- /dev/null +++ b/testsuite/tests/quantified-constraints/T15334.hs @@ -0,0 +1,9 @@ +{-# LANGUAGE MultiParamTypeClasses, PolyKinds, QuantifiedConstraints, RankNTypes #-} + +module T15334 where + +class C m a +class D m a + +f :: (forall a. Eq a => (C m a, D m a)) => m a +f = undefined diff --git a/testsuite/tests/quantified-constraints/T15334.stderr b/testsuite/tests/quantified-constraints/T15334.stderr new file mode 100644 index 0000000000..902d7a71e5 --- /dev/null +++ b/testsuite/tests/quantified-constraints/T15334.stderr @@ -0,0 +1,6 @@ + +T15334.hs:8:6: error: + • You can't specify an instance for a tuple constraint + • In the quantified constraint ‘forall a. Eq a => (C m a, D m a)’ + In the type signature: + f :: (forall a. Eq a => (C m a, D m a)) => m a diff --git a/testsuite/tests/quantified-constraints/T15359.hs b/testsuite/tests/quantified-constraints/T15359.hs new file mode 100644 index 0000000000..7ef1cc5572 --- /dev/null +++ b/testsuite/tests/quantified-constraints/T15359.hs @@ -0,0 +1,12 @@ +{-# LANGUAGE MultiParamTypeClasses, GADTs, RankNTypes, + ConstraintKinds, QuantifiedConstraints #-} + +module T15359 where + +class C a b + +data Dict c where + Dict :: c => Dict c + +foo :: (forall a b. C a b => a ~ b) => Dict (C a b) -> a -> b +foo Dict x = x diff --git a/testsuite/tests/quantified-constraints/T15359a.hs b/testsuite/tests/quantified-constraints/T15359a.hs new file mode 100644 index 0000000000..6ec5f861a8 --- /dev/null +++ b/testsuite/tests/quantified-constraints/T15359a.hs @@ -0,0 +1,14 @@ +{-# LANGUAGE MultiParamTypeClasses, GADTs, RankNTypes, + ConstraintKinds, QuantifiedConstraints, + UndecidableInstances #-} + +module T15359a where + +class C a b +class a ~ b => D a b + +data Dict c where + Dict :: c => Dict c + +foo :: (forall a b. C a b => D a b) => Dict (C a b) -> a -> b +foo Dict x = x diff --git a/testsuite/tests/quantified-constraints/T15625.hs b/testsuite/tests/quantified-constraints/T15625.hs new file mode 100644 index 0000000000..8fe092da98 --- /dev/null +++ b/testsuite/tests/quantified-constraints/T15625.hs @@ -0,0 +1,16 @@ +{-# Language GADTs, MultiParamTypeClasses, QuantifiedConstraints #-} + +module T15625 where + +import Data.Coerce + +class a ~ b => Equal a b + +test1 :: (forall b. a ~ b) => a +test1 = False + +test2 :: (forall b. Equal a b) => a +test2 = False + +test3 :: (forall b. Coercible a b) => a +test3 = coerce False diff --git a/testsuite/tests/quantified-constraints/T15625a.hs b/testsuite/tests/quantified-constraints/T15625a.hs new file mode 100644 index 0000000000..ca049cb19d --- /dev/null +++ b/testsuite/tests/quantified-constraints/T15625a.hs @@ -0,0 +1,20 @@ +{-# Language RankNTypes, ConstraintKinds, QuantifiedConstraints, + PolyKinds, GADTs, MultiParamTypeClasses, + DataKinds, FlexibleInstances #-} + +module T15625a where + +import Data.Kind + +type Cat ob = ob -> ob -> Type + +data KLEISLI (m :: Type -> Type) :: Cat (KL_kind m) where + MkKLEISLI :: (a -> m b) -> KLEISLI(m) (KL a) (KL b) + +data KL_kind (m :: Type -> Type) = KL Type + +class (a ~ KL xx) => AsKL a xx +instance (a ~ KL xx) => AsKL a xx + +ekki__ :: Monad m => (forall xx. AsKL a xx) => KLEISLI m a a +ekki__ = MkKLEISLI undefined diff --git a/testsuite/tests/quantified-constraints/T2893.hs b/testsuite/tests/quantified-constraints/T2893.hs new file mode 100644 index 0000000000..ffec2cf72d --- /dev/null +++ b/testsuite/tests/quantified-constraints/T2893.hs @@ -0,0 +1,18 @@ +{-# LANGUAGE QuantifiedConstraints #-} + +-- Two simple examples that should work + +module T2893 where + +f :: forall b c. (Eq b, forall a. Eq a => Eq (c a)) => c b -> Bool +{-# NOINLINE f #-} +f x = x==x + +g x = f [x] + +data Rose f x = Rose x (f (Rose f x)) + +instance (Eq a, forall b. Eq b => Eq (f b)) + => Eq (Rose f a) where + (Rose x1 rs1) == (Rose x2 rs2) + = x1==x2 && rs1 == rs2 diff --git a/testsuite/tests/quantified-constraints/T2893a.hs b/testsuite/tests/quantified-constraints/T2893a.hs new file mode 100644 index 0000000000..187029fdd5 --- /dev/null +++ b/testsuite/tests/quantified-constraints/T2893a.hs @@ -0,0 +1,27 @@ +{-# LANGUAGE + GADTs + , FlexibleContexts + , RankNTypes + , ScopedTypeVariables + , QuantifiedConstraints #-} + +module T2893a where + +import Control.Monad.ST +import Data.Array.ST + +sortM + :: forall a s. + (Ord a, MArray (STUArray s) a (ST s)) + => [a] + -> ST s [a] +sortM xs = do + arr <- newListArray (1, length xs) xs + :: ST s (STUArray s Int a) + -- do some in-place sorting here + getElems arr + +sortP_3 + :: (Ord a, forall s. MArray (STUArray s) a (ST s)) + => [a] -> [a] +sortP_3 xs = runST (sortM xs) diff --git a/testsuite/tests/quantified-constraints/T2893c.hs b/testsuite/tests/quantified-constraints/T2893c.hs new file mode 100644 index 0000000000..832d0f8428 --- /dev/null +++ b/testsuite/tests/quantified-constraints/T2893c.hs @@ -0,0 +1,15 @@ +{-# LANGUAGE QuantifiedConstraints #-} + +module T2893c where + +data Rose f x = Rose x (f (Rose f x)) + +instance Eq a => Eq (Rose f a) where + (Rose x1 _) == (Rose x2 _) = x1==x2 + +-- Needs superclasses +instance (Ord a, forall b. Ord b => Ord (f b)) + => Ord (Rose f a) where + (Rose x1 rs1) >= (Rose x2 rs2) + = x1 >= x2 && rs1 == rs2 + a <= b = False -- Just to suppress the warning diff --git a/testsuite/tests/quantified-constraints/T9123.hs b/testsuite/tests/quantified-constraints/T9123.hs new file mode 100644 index 0000000000..130312b150 --- /dev/null +++ b/testsuite/tests/quantified-constraints/T9123.hs @@ -0,0 +1,25 @@ +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE QuantifiedConstraints #-} +{-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE InstanceSigs, RoleAnnotations #-} + +module T9123 where + +import Data.Coerce + +type role Wrap representational nominal +newtype Wrap m a = Wrap (m a) + +class Monad' m where + join' :: forall a. m (m a) -> m a + +-- Tests the superclass stuff +instance (forall p q. Coercible p q => Coercible (m p) (m q), Monad' m) => Monad' (Wrap m) where + join' :: forall a. Wrap m (Wrap m a) -> Wrap m a + join' = coerce @(m (m a) -> m a) + @(Wrap m (Wrap m a) -> Wrap m a) + join' + diff --git a/testsuite/tests/quantified-constraints/T9123a.hs b/testsuite/tests/quantified-constraints/T9123a.hs new file mode 100644 index 0000000000..76379b6c00 --- /dev/null +++ b/testsuite/tests/quantified-constraints/T9123a.hs @@ -0,0 +1,30 @@ +{-# LANGUAGE QuantifiedConstraints, PolyKinds, ScopedTypeVariables + , StandaloneDeriving, RoleAnnotations, TypeApplications + , UndecidableInstances, InstanceSigs + , GeneralizedNewtypeDeriving #-} + +module T9123a where + +import Data.Coerce + +class MyMonad m where + join :: m (m a) -> m a + +newtype StateT s m a = StateT (s -> m (a, s)) + +type role StateT nominal representational nominal -- as inferred + +instance MyMonad m => MyMonad (StateT s m) where + join = error "urk" -- A good impl exists, but is not + -- of interest for this test case + +newtype IntStateT m a = IntStateT (StateT Int m a) + +type role IntStateT representational nominal -- as inferred + +instance (MyMonad m, forall p q. Coercible p q => Coercible (m p) (m q)) + => MyMonad (IntStateT m) where + join :: forall a. IntStateT m (IntStateT m a) -> IntStateT m a + join = coerce @(StateT Int m (StateT Int m a) -> StateT Int m a) + @(IntStateT m (IntStateT m a) -> IntStateT m a) + join diff --git a/testsuite/tests/quantified-constraints/all.T b/testsuite/tests/quantified-constraints/all.T new file mode 100644 index 0000000000..1e2eca8358 --- /dev/null +++ b/testsuite/tests/quantified-constraints/all.T @@ -0,0 +1,22 @@ + +test('T14833', normal, compile, ['']) +test('T14835', normal, compile, ['']) +test('T2893', normal, compile, ['']) +test('T2893a', normal, compile, ['']) +test('T2893c', normal, compile, ['']) +test('T9123', normal, compile, ['']) +test('T14863', normal, compile, ['']) +test('T14961', normal, compile, ['']) +test('T9123a', normal, compile, ['']) +test('T15244', normal, compile, ['']) +test('T15231', normal, compile_fail, ['']) + +test('T15290', normal, compile, ['']) +test('T15290a', normal, compile_fail, ['']) +test('T15290b', normal, compile_fail, ['']) +test('T15316', normal, compile_fail, ['']) +test('T15334', normal, compile_fail, ['']) +test('T15359', normal, compile, ['']) +test('T15359a', normal, compile, ['']) +test('T15625', normal, compile, ['']) +test('T15625a', normal, compile, ['']) diff --git a/testsuite/tests/quasiquotation/Makefile b/testsuite/tests/quasiquotation/Makefile index 8e2e7e7c78..76e8a928fb 100644 --- a/testsuite/tests/quasiquotation/Makefile +++ b/testsuite/tests/quasiquotation/Makefile @@ -9,3 +9,7 @@ T4150: '$(TEST_HC)' $(TEST_HC_OPTS) -v0 -c T4150A.hs -'$(TEST_HC)' $(TEST_HC_OPTS) -v0 -c T4150.hs +T14028: + '$(TEST_HC)' $(TEST_HC_OPTS) -v0 T14028Quote.hs + '$(TEST_HC)' $(TEST_HC_OPTS) -v0 -c T14028C.c + '$(TEST_HC)' $(TEST_HC_OPTS) -v0 -fexternal-interpreter T14028 T14028C.o diff --git a/testsuite/tests/quasiquotation/T14028.hs b/testsuite/tests/quasiquotation/T14028.hs new file mode 100644 index 0000000000..5313df6e77 --- /dev/null +++ b/testsuite/tests/quasiquotation/T14028.hs @@ -0,0 +1,8 @@ +{-# LANGUAGE QuasiQuotes #-} + +import T14028Quote + +s :: String +s = [here|goes nothing|] + +main = putStrLn s diff --git a/testsuite/tests/quasiquotation/T14028C.c b/testsuite/tests/quasiquotation/T14028C.c new file mode 100644 index 0000000000..0115013d70 --- /dev/null +++ b/testsuite/tests/quasiquotation/T14028C.c @@ -0,0 +1,5 @@ +#include <stdio.h> + +void hi() { + puts("Hello, World!"); +} diff --git a/testsuite/tests/quasiquotation/T14028Quote.hs b/testsuite/tests/quasiquotation/T14028Quote.hs new file mode 100644 index 0000000000..1080e2f0aa --- /dev/null +++ b/testsuite/tests/quasiquotation/T14028Quote.hs @@ -0,0 +1,9 @@ +module T14028Quote where +import Language.Haskell.TH +import Language.Haskell.TH.Quote + +here :: QuasiQuoter +here = QuasiQuoter { quoteExp = litE . stringL, + quotePat = undefined , + quoteType = undefined, + quoteDec = undefined } diff --git a/testsuite/tests/quasiquotation/T7918.hs b/testsuite/tests/quasiquotation/T7918.hs index 42bb1b05c8..9cf060937e 100644 --- a/testsuite/tests/quasiquotation/T7918.hs +++ b/testsuite/tests/quasiquotation/T7918.hs @@ -29,19 +29,19 @@ traverse a = gmapM traverse a where showVar :: Maybe (HsExpr GhcTc) -> Traverse () - showVar (Just (HsVar (L _ v))) = + showVar (Just (HsVar _ (L _ v))) = modify $ \(loc, ids) -> (loc, (varName v, loc) : ids) showVar _ = return () showTyVar :: Maybe (HsType GhcRn) -> Traverse () - showTyVar (Just (HsTyVar _ (L _ v))) = + showTyVar (Just (HsTyVar _ _ (L _ v))) = modify $ \(loc, ids) -> (loc, (v, loc) : ids) showTyVar _ = return () showPatVar :: Maybe (Pat GhcTc) -> Traverse () - showPatVar (Just (VarPat (L _ v))) = + showPatVar (Just (VarPat _ (L _ v))) = modify $ \(loc, ids) -> (loc, (varName v, loc) : ids) showPatVar _ = return () diff --git a/testsuite/tests/quasiquotation/all.T b/testsuite/tests/quasiquotation/all.T index 84d25f8bdd..a10b8e4446 100644 --- a/testsuite/tests/quasiquotation/all.T +++ b/testsuite/tests/quasiquotation/all.T @@ -6,3 +6,7 @@ test('T7918', [req_interp, extra_run_opts('"' + config.libdir + '"'), only_ways(config.ghc_th_way), unless(have_dynamic(), skip)], compile_and_run, ['-package ghc ' + config.ghc_th_way_flags]) +test('T14028', + [req_interp, only_ways(config.ghc_th_way)], + run_command, + ['$MAKE -s --no-print-directory T14028']) diff --git a/testsuite/tests/quasiquotation/qq005/test.T b/testsuite/tests/quasiquotation/qq005/test.T index 333981a5d4..6e7ec8d14c 100644 --- a/testsuite/tests/quasiquotation/qq005/test.T +++ b/testsuite/tests/quasiquotation/qq005/test.T @@ -1,11 +1,11 @@ test('qq005', [extra_files(['Expr.hs', 'Main.hs']), when(fast(), skip), - reqlib('parsec'), # We'd need to jump through some hoops to run this test the # profiling ways, due to the TH use, so for now we just # omit the profiling ways omit_ways(prof_ways), - extra_clean(['Expr.hi', 'Expr.o', 'Main.hi', 'Main.o'])], + extra_clean(['Expr.hi', 'Expr.o', 'Main.hi', 'Main.o']), + req_interp], multimod_compile_and_run, ['Main', '']) diff --git a/testsuite/tests/quasiquotation/qq006/test.T b/testsuite/tests/quasiquotation/qq006/test.T index e6c4b7c40a..13e6530753 100644 --- a/testsuite/tests/quasiquotation/qq006/test.T +++ b/testsuite/tests/quasiquotation/qq006/test.T @@ -1,3 +1,4 @@ test('qq006', [extra_files(['Expr.hs', 'Main.hs']), - when(fast(), skip), reqlib('parsec')], multimod_compile_fail, + when(fast(), skip), + req_interp], multimod_compile_fail, ['Main', '-v0']) diff --git a/testsuite/tests/quasiquotation/qq007/test.T b/testsuite/tests/quasiquotation/qq007/test.T index edb3554190..7e8251a657 100644 --- a/testsuite/tests/quasiquotation/qq007/test.T +++ b/testsuite/tests/quasiquotation/qq007/test.T @@ -1,5 +1,6 @@ test('qq007', [extra_files(['QQ.hs', 'Test.hs']), when(fast(), skip), pre_cmd('$MAKE -s --no-print-directory TH_QQ'), - omit_ways(prof_ways)], + omit_ways(prof_ways), + req_interp], multimod_compile, ['Test', '-v0 ' + config.ghc_th_way_flags]) diff --git a/testsuite/tests/quasiquotation/qq008/test.T b/testsuite/tests/quasiquotation/qq008/test.T index 9d83f34907..d17ce0deb5 100644 --- a/testsuite/tests/quasiquotation/qq008/test.T +++ b/testsuite/tests/quasiquotation/qq008/test.T @@ -1,5 +1,6 @@ test('qq008', [extra_files(['QQ.hs', 'Test.hs']), when(fast(), skip), pre_cmd('$MAKE -s --no-print-directory TH_QQ'), - omit_ways(prof_ways)], + omit_ways(prof_ways), + req_interp], multimod_compile, ['Test', '-v0 ' + config.ghc_th_way_flags]) diff --git a/testsuite/tests/quasiquotation/qq009/test.T b/testsuite/tests/quasiquotation/qq009/test.T index 1f108a626e..2dfb976298 100644 --- a/testsuite/tests/quasiquotation/qq009/test.T +++ b/testsuite/tests/quasiquotation/qq009/test.T @@ -1,5 +1,6 @@ test('qq009', [extra_files(['QQ.hs', 'Test.hs']), when(fast(), skip), pre_cmd('$MAKE -s --no-print-directory TH_QQ'), - omit_ways(prof_ways)], + omit_ways(prof_ways), + req_interp], multimod_compile, ['Test', '-v0 ' + config.ghc_th_way_flags]) diff --git a/testsuite/tests/quotes/TH_localname.stderr b/testsuite/tests/quotes/TH_localname.stderr index a5af954e82..41eb9882e8 100644 --- a/testsuite/tests/quotes/TH_localname.stderr +++ b/testsuite/tests/quotes/TH_localname.stderr @@ -5,7 +5,7 @@ TH_localname.hs:3:11: error: t0)’ from being solved. Relevant bindings include y :: t0 (bound at TH_localname.hs:3:6) - x :: t0 -> Language.Haskell.TH.Lib.ExpQ + x :: t0 -> Language.Haskell.TH.Lib.Internal.ExpQ (bound at TH_localname.hs:3:1) Probable fix: use a type annotation to specify what ‘t0’ should be. These potential instances exist: diff --git a/testsuite/tests/rebindable/T14670.hs b/testsuite/tests/rebindable/T14670.hs new file mode 100644 index 0000000000..8a99c576ed --- /dev/null +++ b/testsuite/tests/rebindable/T14670.hs @@ -0,0 +1,11 @@ +{-# LANGUAGE RebindableSyntax #-} + +module Lib where + +import Prelude (IO) + +pure = undefined + +foo :: IO () +foo = do + pure () diff --git a/testsuite/tests/rebindable/T5908.hs b/testsuite/tests/rebindable/T5908.hs index 32a4d4e5e7..2666c3371a 100644 --- a/testsuite/tests/rebindable/T5908.hs +++ b/testsuite/tests/rebindable/T5908.hs @@ -26,7 +26,7 @@ class Monad m where (>>) :: forall e ex x a b . m e ex a -> m ex x b -> m e x b return :: a -> m ex ex a fail :: String -> m e x a - + {-# INLINE (>>) #-} m >> k = m >>= \ _ -> k fail = error diff --git a/testsuite/tests/rebindable/all.T b/testsuite/tests/rebindable/all.T index dd51e2b1cf..f796a38750 100644 --- a/testsuite/tests/rebindable/all.T +++ b/testsuite/tests/rebindable/all.T @@ -3,7 +3,7 @@ # # Written by Ashley Yakeley -# No point in doing anything except the normal way +# No point in doing anything except the normal way setTestOpts(only_ways(['normal'])); test('rebindable1', normal, compile, ['']) @@ -25,7 +25,7 @@ test('T303', normal, compile, ['']) # Tests from Oleg test('DoRestrictedM', normal, compile, ['']) -test('DoParamM', reqlib('mtl'), compile_fail, ['']) +test('DoParamM', normal, compile_fail, ['']) test('T5038', normal, compile_and_run, ['']) test('T4851', normal, compile, ['']) @@ -34,3 +34,4 @@ test('T10112', normal, compile, ['']) test('T11216', normal, compile, ['']) test('T11216A', normal, compile, ['']) test('T12080', normal, compile, ['']) +test('T14670', expect_broken(14670), compile, ['']) diff --git a/testsuite/tests/rebindable/rebindable1.hs b/testsuite/tests/rebindable/rebindable1.hs index 8fcc5d2697..fcbe52fbc1 100644 --- a/testsuite/tests/rebindable/rebindable1.hs +++ b/testsuite/tests/rebindable/rebindable1.hs @@ -1,5 +1,5 @@ {-# OPTIONS_GHC -Wno-missing-monadfail-instances #-} -{-# LANGUAGE RebindableSyntax, NPlusKPatterns #-} +{-# LANGUAGE RebindableSyntax, NPlusKPatterns, NoMonadFailDesugaring #-} module RebindableCase1 where { diff --git a/testsuite/tests/rebindable/rebindable6.stderr b/testsuite/tests/rebindable/rebindable6.stderr index 342ee53de5..1dbbab5c00 100644 --- a/testsuite/tests/rebindable/rebindable6.stderr +++ b/testsuite/tests/rebindable/rebindable6.stderr @@ -33,7 +33,8 @@ rebindable6.hs:111:17: error: g :: IO (Maybe b) (bound at rebindable6.hs:108:19) test_do :: IO a -> IO (Maybe b) -> IO b (bound at rebindable6.hs:108:9) - Probable fix: use a type annotation to specify what ‘p0’, ‘t0’ should be. + Probable fix: use a type annotation to specify what ‘p0’, + ‘t0’ should be. These potential instance exist: instance HasBind (IO a -> (a -> IO b) -> IO b) -- Defined at rebindable6.hs:51:18 diff --git a/testsuite/tests/regalloc/regalloc_unit_tests.hs b/testsuite/tests/regalloc/regalloc_unit_tests.hs index 9a9a640d5d..66aa51a050 100644 --- a/testsuite/tests/regalloc/regalloc_unit_tests.hs +++ b/testsuite/tests/regalloc/regalloc_unit_tests.hs @@ -112,7 +112,7 @@ compileCmmForRegAllocStats dflags' cmmFile ncgImplF us = do -- print parser errors or warnings mapM_ (printBagOfErrors dflags) [warningMsgs, errorMsgs] - let initTopSRT = initUs_ usa emptySRT + let initTopSRT = emptySRT thisMod cmmGroup <- fmap snd $ cmmPipeline hscEnv initTopSRT $ fromJust parsedCmm rawCmms <- cmmToRawCmm dflags (Stream.yield cmmGroup) diff --git a/testsuite/tests/rename/should_compile/T10816.hs b/testsuite/tests/rename/should_compile/T10816.hs new file mode 100644 index 0000000000..3f8cc604f0 --- /dev/null +++ b/testsuite/tests/rename/should_compile/T10816.hs @@ -0,0 +1,11 @@ +{-# LANGUAGE TypeOperators, TypeFamilies #-} +module T10816 where + +class C a where + type a # b + infix 4 # + + type a *** b + type a +++ b + infixr 5 ***, +++ + (***), (+++) :: a -> a -> a diff --git a/testsuite/tests/rename/should_compile/T14487.hs b/testsuite/tests/rename/should_compile/T14487.hs new file mode 100644 index 0000000000..dacf4188fc --- /dev/null +++ b/testsuite/tests/rename/should_compile/T14487.hs @@ -0,0 +1,7 @@ +module T14487 where + +import T14487A hiding (duplicateName) + +test = X duplicateName + +duplicateName = 5 diff --git a/testsuite/tests/rename/should_compile/T14487A.hs b/testsuite/tests/rename/should_compile/T14487A.hs new file mode 100644 index 0000000000..e3e6fd758c --- /dev/null +++ b/testsuite/tests/rename/should_compile/T14487A.hs @@ -0,0 +1,7 @@ +{-# LANGUAGE DuplicateRecordFields #-} + +module T14487A where + +data X = X { + duplicateName :: Int +} diff --git a/testsuite/tests/rename/should_compile/T14747.hs b/testsuite/tests/rename/should_compile/T14747.hs new file mode 100644 index 0000000000..6dde0bdab9 --- /dev/null +++ b/testsuite/tests/rename/should_compile/T14747.hs @@ -0,0 +1,9 @@ +{-# LANGUAGE PatternSynonyms, DisambiguateRecordFields #-} + +module T14747 where + +import T14747A + +pattern T{x} = [x] + +e = S { x = 42 } diff --git a/testsuite/tests/rename/should_compile/T14747A.hs b/testsuite/tests/rename/should_compile/T14747A.hs new file mode 100644 index 0000000000..a3b6e604e4 --- /dev/null +++ b/testsuite/tests/rename/should_compile/T14747A.hs @@ -0,0 +1,5 @@ +{-# LANGUAGE PatternSynonyms #-} + +module T14747A where + +pattern S{x} = [x] diff --git a/testsuite/tests/rename/should_compile/T14881.hs b/testsuite/tests/rename/should_compile/T14881.hs new file mode 100644 index 0000000000..c1b955c0f2 --- /dev/null +++ b/testsuite/tests/rename/should_compile/T14881.hs @@ -0,0 +1,5 @@ +module T14881 where + +import qualified T14881Aux as Aux (L(Cons), x, tail, adjust, length) + +x = Aux.Cons diff --git a/testsuite/tests/rename/should_compile/T14881.stderr b/testsuite/tests/rename/should_compile/T14881.stderr new file mode 100644 index 0000000000..bfb6ca913f --- /dev/null +++ b/testsuite/tests/rename/should_compile/T14881.stderr @@ -0,0 +1,6 @@ +[1 of 2] Compiling T14881Aux ( T14881Aux.hs, T14881Aux.o ) +[2 of 2] Compiling T14881 ( T14881.hs, T14881.o ) + +T14881.hs:3:1: warning: [-Wunused-imports (in -Wextra)] + The qualified import of ‘adjust, length, L(tail), L(x)’ + from module ‘T14881Aux’ is redundant diff --git a/testsuite/tests/rename/should_compile/T14881Aux.hs b/testsuite/tests/rename/should_compile/T14881Aux.hs new file mode 100644 index 0000000000..13b8f31d04 --- /dev/null +++ b/testsuite/tests/rename/should_compile/T14881Aux.hs @@ -0,0 +1,13 @@ +module T14881Aux where + +-- unambiguous function name. +adjust :: () +adjust = undefined + +-- ambiguous function name. +length :: () +length = undefined + +data L = Cons { x :: Int -- unambiguous field selector + , tail :: [Int] -- ambiguous field selector + } diff --git a/testsuite/tests/rename/should_compile/T15149.hs b/testsuite/tests/rename/should_compile/T15149.hs new file mode 100644 index 0000000000..e2e77db9a1 --- /dev/null +++ b/testsuite/tests/rename/should_compile/T15149.hs @@ -0,0 +1,5 @@ +{-# LANGUAGE DisambiguateRecordFields #-} +module Main where +import T15149B +import T15149C +main = do print (AnDouble{an=1}, AnInt{an=1}) diff --git a/testsuite/tests/rename/should_compile/T15149A.hs b/testsuite/tests/rename/should_compile/T15149A.hs new file mode 100644 index 0000000000..09b9beb36f --- /dev/null +++ b/testsuite/tests/rename/should_compile/T15149A.hs @@ -0,0 +1,4 @@ +{-# LANGUAGE TypeFamilies #-} +module T15149A where + +data family An c :: * diff --git a/testsuite/tests/rename/should_compile/T15149B.hs b/testsuite/tests/rename/should_compile/T15149B.hs new file mode 100644 index 0000000000..9a9508da08 --- /dev/null +++ b/testsuite/tests/rename/should_compile/T15149B.hs @@ -0,0 +1,4 @@ +{-# LANGUAGE TypeFamilies #-} +module T15149B where +import T15149A +data instance An Int = AnInt {an :: Int} deriving Show diff --git a/testsuite/tests/rename/should_compile/T15149C.hs b/testsuite/tests/rename/should_compile/T15149C.hs new file mode 100644 index 0000000000..ca1a7f88fb --- /dev/null +++ b/testsuite/tests/rename/should_compile/T15149C.hs @@ -0,0 +1,4 @@ +{-# LANGUAGE TypeFamilies #-} +module T15149C where +import T15149A +data instance An Double = AnDouble {an :: Double} deriving Show diff --git a/testsuite/tests/rename/should_compile/T1792_imports.stdout b/testsuite/tests/rename/should_compile/T1792_imports.stdout index 9c502c61b5..b497d12ec6 100644 --- a/testsuite/tests/rename/should_compile/T1792_imports.stdout +++ b/testsuite/tests/rename/should_compile/T1792_imports.stdout @@ -1 +1 @@ -import qualified Data.ByteString as B ( readFile, putStr ) +import qualified Data.ByteString as B ( putStr, readFile ) diff --git a/testsuite/tests/rename/should_compile/T4239.stdout b/testsuite/tests/rename/should_compile/T4239.stdout index 6e55a4ea26..a1f53d2c9e 100644 --- a/testsuite/tests/rename/should_compile/T4239.stdout +++ b/testsuite/tests/rename/should_compile/T4239.stdout @@ -1 +1 @@ -import T4239A ( type (:+++)((:---), X, (:+++)), (·) ) +import T4239A ( (·), type (:+++)((:---), X, (:+++)) ) diff --git a/testsuite/tests/rename/should_compile/T5331.stderr b/testsuite/tests/rename/should_compile/T5331.stderr index 9bc0b102b7..fb27e64af1 100644 --- a/testsuite/tests/rename/should_compile/T5331.stderr +++ b/testsuite/tests/rename/should_compile/T5331.stderr @@ -5,7 +5,7 @@ T5331.hs:8:17: warning: [-Wunused-foralls (in -Wextra)] T5331.hs:11:16: warning: [-Wunused-foralls (in -Wextra)] Unused quantified type variable ‘a’ - In the type ‘forall a. W’ + In the definition of data constructor ‘W1’ T5331.hs:13:13: warning: [-Wunused-foralls (in -Wextra)] Unused quantified type variable ‘a’ diff --git a/testsuite/tests/rename/should_compile/all.T b/testsuite/tests/rename/should_compile/all.T index 0b46f90e17..3a90cbd667 100644 --- a/testsuite/tests/rename/should_compile/all.T +++ b/testsuite/tests/rename/should_compile/all.T @@ -33,7 +33,7 @@ test('rn037', normal, compile, ['']) test('rn039', normal, compile, ['']) test('rn040', normal, compile, ['-fwarn-unused-binds -fwarn-unused-matches']) -test('rn041', expect_broken_for(10181, ['optasm', 'optllvm']), compile, ['']) +test('rn041', normal, compile, ['']) test('rn042', [extra_files(['Rn042_A.hs'])], multimod_compile, ['rn042', '-v0']) test('rn043', [extra_files(['Rn043_A.hs', 'Rn043_B.hs'])], multimod_compile, ['rn043', '-v0']) test('rn044', [extra_files(['Rn044_A.hs', 'Rn044_B.hs'])], multimod_compile, ['rn044', '-v0']) @@ -139,6 +139,7 @@ test('T7969', [], run_command, ['$MAKE -s --no-print-directory T7969']) test('T9127', normal, compile, ['']) test('T4426', normal, compile_fail, ['']) test('T9778', normal, compile, ['-fwarn-unticked-promoted-constructors']) +test('T10816', normal, compile, ['']) test('T11164', [], multimod_compile, ['T11164', '-v0']) test('T11167', normal, compile, ['']) test('T11167_ambig', normal, compile, ['']) @@ -152,3 +153,7 @@ test('T12548', normal, compile, ['']) test('T13132', normal, compile, ['']) test('T13646', normal, compile, ['']) test('LookupSub', [], multimod_compile, ['LookupSub', '-v0']) +test('T14881', [], multimod_compile, ['T14881', '-W']) +test('T14487', [], multimod_compile, ['T14487', '-v0']) +test('T14747', [], multimod_compile, ['T14747', '-v0']) +test('T15149', [], multimod_compile, ['T15149', '-v0']) diff --git a/testsuite/tests/rename/should_fail/T10618.hs b/testsuite/tests/rename/should_fail/T10618.hs index 28b665f6fb..d69cf3d409 100644 --- a/testsuite/tests/rename/should_fail/T10618.hs +++ b/testsuite/tests/rename/should_fail/T10618.hs @@ -1,3 +1,3 @@ module T10618 where -foo = Just $ Nothing <> Nothing +foo = Just $ Nothing <|> Nothing diff --git a/testsuite/tests/rename/should_fail/T10618.stderr b/testsuite/tests/rename/should_fail/T10618.stderr index 8b4dc2c28d..2d478744e1 100644 --- a/testsuite/tests/rename/should_fail/T10618.stderr +++ b/testsuite/tests/rename/should_fail/T10618.stderr @@ -1,6 +1,6 @@ T10618.hs:3:22: error: - • Variable not in scope: (<>) :: Maybe (Maybe a0) -> Maybe a1 -> t + • Variable not in scope: (<|>) :: Maybe (Maybe a0) -> Maybe a1 -> t • Perhaps you meant one of these: - ‘<$>’ (imported from Prelude), ‘*>’ (imported from Prelude), - ‘<$’ (imported from Prelude) + ‘<$>’ (imported from Prelude), ‘<*>’ (imported from Prelude), + ‘<>’ (imported from Prelude) diff --git a/testsuite/tests/rename/should_fail/T11592.hs b/testsuite/tests/rename/should_fail/T11592.hs index b963cdf8ba..53714f1a68 100644 --- a/testsuite/tests/rename/should_fail/T11592.hs +++ b/testsuite/tests/rename/should_fail/T11592.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE TypeInType #-} +{-# LANGUAGE PolyKinds #-} module Bug11592 where diff --git a/testsuite/tests/rename/should_fail/T11592.stderr b/testsuite/tests/rename/should_fail/T11592.stderr index bffea1cca7..9adac1549b 100644 --- a/testsuite/tests/rename/should_fail/T11592.stderr +++ b/testsuite/tests/rename/should_fail/T11592.stderr @@ -1,19 +1,8 @@ -T11592.hs:5:9: - Variable ‘a’ is used in the kind signature of its - declaration as a type variable. - the data type declaration for ‘A’ -T11592.hs:7:11: - Variable ‘a’ is used in the kind signature of its - declaration as a type variable. - the data type declaration for ‘B’ +T11592.hs:5:14: error: Not in scope: type variable ‘a’ -T11592.hs:8:11: - Variable ‘a’ is used in the kind signature of its - declaration as a type variable. - the data type declaration for ‘C’ +T11592.hs:7:16: error: Not in scope: type variable ‘a’ -T11592.hs:10:13: - Variable ‘a’ is used in the kind signature of its - declaration as a type variable. - the data type declaration for ‘D’ +T11592.hs:8:18: error: Not in scope: type variable ‘a’ + +T11592.hs:10:20: error: Not in scope: type variable ‘a’ diff --git a/testsuite/tests/rename/should_fail/T12146.hs b/testsuite/tests/rename/should_fail/T12146.hs new file mode 100644 index 0000000000..e44be13f04 --- /dev/null +++ b/testsuite/tests/rename/should_fail/T12146.hs @@ -0,0 +1,5 @@ +-- Test Trac #12146 + +module T12146 where + +ipmort Data.Char diff --git a/testsuite/tests/rename/should_fail/T12146.stderr b/testsuite/tests/rename/should_fail/T12146.stderr new file mode 100644 index 0000000000..0dcd15470d --- /dev/null +++ b/testsuite/tests/rename/should_fail/T12146.stderr @@ -0,0 +1,4 @@ + +T12146.hs:5:1: + Parse error: module header, import declaration + or top-level declaration expected. diff --git a/testsuite/tests/rename/should_fail/T13847.hs b/testsuite/tests/rename/should_fail/T13847.hs new file mode 100644 index 0000000000..09c67de54f --- /dev/null +++ b/testsuite/tests/rename/should_fail/T13847.hs @@ -0,0 +1,4 @@ +module Main where +import qualified T13847A as A +foo = "foo" +main = print $ A.foo $ A.A { foo = () } diff --git a/testsuite/tests/rename/should_fail/T13847.stderr b/testsuite/tests/rename/should_fail/T13847.stderr new file mode 100644 index 0000000000..52edbf5acf --- /dev/null +++ b/testsuite/tests/rename/should_fail/T13847.stderr @@ -0,0 +1,6 @@ + +T13847.hs:4:24: error: + • Constructor ‘A.A’ does not have field ‘foo’ + • In the second argument of ‘($)’, namely ‘A.A {foo = ()}’ + In the second argument of ‘($)’, namely ‘A.foo $ A.A {foo = ()}’ + In the expression: print $ A.foo $ A.A {foo = ()} diff --git a/testsuite/tests/rename/should_fail/T13847A.hs b/testsuite/tests/rename/should_fail/T13847A.hs new file mode 100644 index 0000000000..e3e54a8f18 --- /dev/null +++ b/testsuite/tests/rename/should_fail/T13847A.hs @@ -0,0 +1,2 @@ +module T13847A where +data A = A { foo :: () } diff --git a/testsuite/tests/rename/should_fail/T13947.stderr b/testsuite/tests/rename/should_fail/T13947.stderr index 8a636a2bb9..8533f9f743 100644 --- a/testsuite/tests/rename/should_fail/T13947.stderr +++ b/testsuite/tests/rename/should_fail/T13947.stderr @@ -1,3 +1,3 @@ -T13947.hs:4:12: error: +T13947.hs:4:16: error: Not in scope: type constructor or class ‘:~:’ diff --git a/testsuite/tests/rename/should_fail/T14307.hs b/testsuite/tests/rename/should_fail/T14307.hs new file mode 100644 index 0000000000..9bb33b7425 --- /dev/null +++ b/testsuite/tests/rename/should_fail/T14307.hs @@ -0,0 +1,10 @@ +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE NamedFieldPuns #-} + +module T14307 where + +data A = A { field :: Int } +data B = B { field :: Int } + +f :: B -> Int +f (C { field }) = field diff --git a/testsuite/tests/rename/should_fail/T14307.stderr b/testsuite/tests/rename/should_fail/T14307.stderr new file mode 100644 index 0000000000..1470a406d4 --- /dev/null +++ b/testsuite/tests/rename/should_fail/T14307.stderr @@ -0,0 +1,2 @@ + +T14307.hs:10:4: error: Not in scope: data constructor ‘C’ diff --git a/testsuite/tests/rename/should_fail/T14591.hs b/testsuite/tests/rename/should_fail/T14591.hs new file mode 100644 index 0000000000..44313427fb --- /dev/null +++ b/testsuite/tests/rename/should_fail/T14591.hs @@ -0,0 +1,12 @@ +-- Checks that the ordering constraint on the groupWith function is respected +{-# OPTIONS_GHC -XMonadComprehensions -XTransformListComp #-} + +module T14591 where + +import GHC.Exts (groupWith) + +data Unorderable = Gnorf | Pinky | Brain +foo = [ () + | Gnorf <- [Gnorf, Brain] + , then group by x using groupWith + ] diff --git a/testsuite/tests/rename/should_fail/T14591.stderr b/testsuite/tests/rename/should_fail/T14591.stderr new file mode 100644 index 0000000000..47e4df0d55 --- /dev/null +++ b/testsuite/tests/rename/should_fail/T14591.stderr @@ -0,0 +1,2 @@ + +T14591.hs:11:23: error: Variable not in scope: x diff --git a/testsuite/tests/rename/should_fail/T15214.hs b/testsuite/tests/rename/should_fail/T15214.hs new file mode 100644 index 0000000000..55f15593be --- /dev/null +++ b/testsuite/tests/rename/should_fail/T15214.hs @@ -0,0 +1,4 @@ +{-# LANGUAGE TypeOperators #-} +module T15214 where + +type (~) = Either diff --git a/testsuite/tests/rename/should_fail/T15214.stderr b/testsuite/tests/rename/should_fail/T15214.stderr new file mode 100644 index 0000000000..399438adb5 --- /dev/null +++ b/testsuite/tests/rename/should_fail/T15214.stderr @@ -0,0 +1,2 @@ + +T15214.hs:4:1: error: Illegal binding of built-in syntax: ~ diff --git a/testsuite/tests/rename/should_fail/T15487.hs b/testsuite/tests/rename/should_fail/T15487.hs new file mode 100644 index 0000000000..62e69e3805 --- /dev/null +++ b/testsuite/tests/rename/should_fail/T15487.hs @@ -0,0 +1,7 @@ +module T15487 where + +import qualified T15487a + +null = 42 + +foo x = null diff --git a/testsuite/tests/rename/should_fail/T15487.stderr b/testsuite/tests/rename/should_fail/T15487.stderr new file mode 100644 index 0000000000..bb25939f4b --- /dev/null +++ b/testsuite/tests/rename/should_fail/T15487.stderr @@ -0,0 +1,8 @@ + +T15487.hs:7:9: error: + Ambiguous occurrence ‘null’ + It could refer to + either ‘Prelude.null’, + imported from ‘Prelude’ at T15487.hs:1:8-13 + (and originally defined in ‘Data.Foldable’) + or ‘T15487.null’, defined at T15487.hs:5:1 diff --git a/testsuite/tests/rename/should_fail/T15487a.hs b/testsuite/tests/rename/should_fail/T15487a.hs new file mode 100644 index 0000000000..e8687eee44 --- /dev/null +++ b/testsuite/tests/rename/should_fail/T15487a.hs @@ -0,0 +1 @@ +module T15487a (null) where diff --git a/testsuite/tests/rename/should_fail/T15539.hs b/testsuite/tests/rename/should_fail/T15539.hs new file mode 100644 index 0000000000..d1b5a37e7b --- /dev/null +++ b/testsuite/tests/rename/should_fail/T15539.hs @@ -0,0 +1,17 @@ +{-# LANGUAGE RankNTypes #-} +module T15539 where + +foo :: String +foo = show a + where a = baz + +-- We get top level constraints +-- Show a +-- forall . <not in scope baz> +-- We want the insoluble non-in-scope error to suppress +-- the Show a, just as it does if the whole things is nested + +bar :: Int +bar = 1 + +bam = putStrLn foo diff --git a/testsuite/tests/rename/should_fail/T15539.stderr b/testsuite/tests/rename/should_fail/T15539.stderr new file mode 100644 index 0000000000..c3de7780d4 --- /dev/null +++ b/testsuite/tests/rename/should_fail/T15539.stderr @@ -0,0 +1,4 @@ + +T15539.hs:6:13: error: + • Variable not in scope: baz + • Perhaps you meant one of these: ‘bar’ (line 15), ‘bam’ (line 17) diff --git a/testsuite/tests/rename/should_fail/T15607.hs b/testsuite/tests/rename/should_fail/T15607.hs new file mode 100644 index 0000000000..a692ca5580 --- /dev/null +++ b/testsuite/tests/rename/should_fail/T15607.hs @@ -0,0 +1,6 @@ +{-# LANGUAGE RebindableSyntax #-}
+module T15607 where
+
+import Prelude hiding (pure, return)
+
+t = do { pure 5 }
diff --git a/testsuite/tests/rename/should_fail/T15607.stderr b/testsuite/tests/rename/should_fail/T15607.stderr new file mode 100644 index 0000000000..9bc84f42f7 --- /dev/null +++ b/testsuite/tests/rename/should_fail/T15607.stderr @@ -0,0 +1,5 @@ + +T15607.hs:6:10: error: + • Variable not in scope: pure :: Integer -> t + • Perhaps you want to remove ‘pure’ from the explicit hiding list + in the import of ‘Prelude’ (T15607.hs:4:1-36). diff --git a/testsuite/tests/rename/should_fail/T15659.hs b/testsuite/tests/rename/should_fail/T15659.hs new file mode 100644 index 0000000000..9fa516f2b6 --- /dev/null +++ b/testsuite/tests/rename/should_fail/T15659.hs @@ -0,0 +1,5 @@ +module T15659 where + +{-# RULES "test" forall x. f x = x #-} + + diff --git a/testsuite/tests/rename/should_fail/T15659.stderr b/testsuite/tests/rename/should_fail/T15659.stderr new file mode 100644 index 0000000000..e1cbf9f079 --- /dev/null +++ b/testsuite/tests/rename/should_fail/T15659.stderr @@ -0,0 +1,6 @@ + +T15659.hs:3:11: error: + Rule "test": + Not in scope: ‘f’ + in left-hand side: f x + LHS must be of form (f e1 .. en) where f is not forall'd diff --git a/testsuite/tests/rename/should_fail/T2310.hs b/testsuite/tests/rename/should_fail/T2310.hs deleted file mode 100644 index 10c9cbc72a..0000000000 --- a/testsuite/tests/rename/should_fail/T2310.hs +++ /dev/null @@ -1,5 +0,0 @@ -{-# OPTIONS_GHC -XScopedTypeVariables #-} - -module Foo where - -foo = let c = \ (x :: a) -> (x :: a) in co diff --git a/testsuite/tests/rename/should_fail/T2310.stderr b/testsuite/tests/rename/should_fail/T2310.stderr deleted file mode 100644 index 1ac633f290..0000000000 --- a/testsuite/tests/rename/should_fail/T2310.stderr +++ /dev/null @@ -1,5 +0,0 @@ - -T2310.hs:5:41: error: - • Variable not in scope: co - • Perhaps you meant one of these: - ‘c’ (line 5), ‘cos’ (imported from Prelude) diff --git a/testsuite/tests/rename/should_fail/T2901.stderr b/testsuite/tests/rename/should_fail/T2901.stderr index 2128989b4c..d5a5bbda9a 100644 --- a/testsuite/tests/rename/should_fail/T2901.stderr +++ b/testsuite/tests/rename/should_fail/T2901.stderr @@ -2,7 +2,3 @@ T2901.hs:6:5: error: Not in scope: data constructor ‘F.Foo’ No module named ‘F’ is imported. - -T2901.hs:6:13: error: - Not in scope: ‘F.field’ - No module named ‘F’ is imported. diff --git a/testsuite/tests/rename/should_fail/T5372.stderr b/testsuite/tests/rename/should_fail/T5372.stderr index f6a466eb6c..d8b8e8fa56 100644 --- a/testsuite/tests/rename/should_fail/T5372.stderr +++ b/testsuite/tests/rename/should_fail/T5372.stderr @@ -2,7 +2,3 @@ T5372.hs:4:11: error: Not in scope: data constructor ‘MkS’ Perhaps you meant ‘T5372a.MkS’ (imported from T5372a) - -T5372.hs:4:17: error: - Not in scope: ‘x’ - Perhaps you meant ‘T5372a.x’ (imported from T5372a) diff --git a/testsuite/tests/rename/should_fail/T5513.stderr b/testsuite/tests/rename/should_fail/T5513.stderr index 063f34822b..4ce02ace8b 100644 --- a/testsuite/tests/rename/should_fail/T5513.stderr +++ b/testsuite/tests/rename/should_fail/T5513.stderr @@ -1,2 +1,4 @@ -T5513.hs:4:19: Malformed instance: lowercase_name a +T5513.hs:4:19: error: + • Instance head is not headed by a class: lowercase_name a + • In the stand-alone deriving instance for ‘lowercase_name a’ diff --git a/testsuite/tests/rename/should_fail/T5951.stderr b/testsuite/tests/rename/should_fail/T5951.stderr index af0ee9d431..a6969971ab 100644 --- a/testsuite/tests/rename/should_fail/T5951.stderr +++ b/testsuite/tests/rename/should_fail/T5951.stderr @@ -1,2 +1,19 @@ -T5951.hs:8:8: Malformed instance: A => B => C +T5951.hs:8:8: error: + • Expecting one more argument to ‘A’ + Expected a constraint, but ‘A’ has kind ‘* -> Constraint’ + • In the instance declaration for ‘B => C’ + +T5951.hs:8:8: error: + • Instance head is not headed by a class: C + • In the instance declaration for ‘B => C’ + +T5951.hs:9:8: error: + • Expecting one more argument to ‘B’ + Expected a constraint, but ‘B’ has kind ‘* -> Constraint’ + • In the instance declaration for ‘B => C’ + +T5951.hs:10:8: error: + • Expecting one more argument to ‘C’ + Expected a constraint, but ‘C’ has kind ‘* -> Constraint’ + • In the instance declaration for ‘B => C’ diff --git a/testsuite/tests/rename/should_fail/T8448.stderr b/testsuite/tests/rename/should_fail/T8448.stderr index e5834fbcaf..4b84290863 100644 --- a/testsuite/tests/rename/should_fail/T8448.stderr +++ b/testsuite/tests/rename/should_fail/T8448.stderr @@ -1,2 +1,6 @@ -T8448.hs:5:21: ‘r’ is not a (visible) field of constructor ‘[]’ +T8448.hs:5:17: error: + • Constructor ‘[]’ does not have field ‘r’ + • In the first argument of ‘undefined’, namely ‘[] {r = x}’ + In the expression: undefined [] {r = x} + In an equation for ‘f’: f x = undefined [] {r = x} diff --git a/testsuite/tests/rename/should_fail/all.T b/testsuite/tests/rename/should_fail/all.T index f7f77192c8..182dc421fb 100644 --- a/testsuite/tests/rename/should_fail/all.T +++ b/testsuite/tests/rename/should_fail/all.T @@ -60,7 +60,6 @@ test('rnfail056', normal, compile_fail, ['']) test('rnfail057', normal, compile_fail, ['']) test('rn_dup', normal, compile_fail, ['']) -test('T2310', normal, compile_fail, ['']) test('T2490', normal, compile_fail, ['']) test('T2901', normal, compile_fail, ['']) test('T2723', normal, compile, ['']) # Warnings only @@ -120,11 +119,20 @@ test('T10781', normal, compile_fail, ['']) test('T11071', normal, compile_fail, ['']) test('T11071a', normal, compile_fail, ['']) test('T11663', normal, compile_fail, ['']) +test('T12146', normal, compile_fail, ['']) test('T12229', normal, compile, ['']) test('T12681', normal, multimod_compile_fail, ['T12681','-v0']) test('T12686', normal, compile_fail, ['']) test('T11592', normal, compile_fail, ['']) test('T12879', normal, compile_fail, ['']) -test('T13644', expect_broken(13644), multimod_compile_fail, ['T13644','-v0']) +test('T13644', normal, multimod_compile_fail, ['T13644','-v0']) test('T13568', normal, multimod_compile_fail, ['T13568','-v0']) test('T13947', normal, compile_fail, ['']) +test('T13847', normal, multimod_compile_fail, ['T13847','-v0']) +test('T14307', normal, compile_fail, ['']) +test('T14591', normal, compile_fail, ['']) +test('T15214', normal, compile_fail, ['']) +test('T15539', normal, compile_fail, ['']) +test('T15487', normal, multimod_compile_fail, ['T15487','-v0']) +test('T15659', normal, compile_fail, ['']) +test('T15607', normal, compile_fail, ['']) diff --git a/testsuite/tests/rename/should_fail/rnfail026.hs b/testsuite/tests/rename/should_fail/rnfail026.hs index d09d9fc22f..2d22df20d4 100644 --- a/testsuite/tests/rename/should_fail/rnfail026.hs +++ b/testsuite/tests/rename/should_fail/rnfail026.hs @@ -1,6 +1,6 @@ {-# LANGUAGE RankNTypes, FlexibleInstances #-} --- This one made ghc-4.08 crash +-- This one made ghc-4.08 crash -- rename/RnEnv.lhs:239: Non-exhaustive patterns in function get_tycon_key -- The type in the Monad instance is utterly bogus, of course @@ -9,11 +9,12 @@ module ShouldCompile ( Set ) where data Set a = Set [a] deriving (Eq, Ord, Read, Show) - +{- instance Functor Set where f `fmap` (Set xs) = Set $ f `fmap` xs - +-} instance Monad (forall a. Eq a => Set a) where return x = Set [x] - -instance Eq (forall a. [a]) where +{- +instance Eq (forall a. [a]) where +-} diff --git a/testsuite/tests/rename/should_fail/rnfail026.stderr b/testsuite/tests/rename/should_fail/rnfail026.stderr index dc6ee9691a..79b07c4d24 100644 --- a/testsuite/tests/rename/should_fail/rnfail026.stderr +++ b/testsuite/tests/rename/should_fail/rnfail026.stderr @@ -1,11 +1,10 @@ +rnfail026.hs:16:10: error: + • Illegal polymorphic type: forall a. Eq a => Set a + • In the instance declaration for ‘Monad (forall a. Eq a => Set a)’ + rnfail026.hs:16:27: error: - • Expecting one fewer arguments to ‘Set a’ - Expected kind ‘* -> *’, but ‘Set a’ has kind ‘*’ + • Expected kind ‘* -> *’, but ‘Set a’ has kind ‘*’ • In the first argument of ‘Monad’, namely ‘(forall a. Eq a => Set a)’ In the instance declaration for ‘Monad (forall a. Eq a => Set a)’ - -rnfail026.hs:19:10: error: - • Illegal polymorphic type: forall a. [a] - • In the instance declaration for ‘Eq (forall a. [a])’ diff --git a/testsuite/tests/rename/should_fail/rnfail028.stderr b/testsuite/tests/rename/should_fail/rnfail028.stderr index f09cda3f33..848e39e920 100644 --- a/testsuite/tests/rename/should_fail/rnfail028.stderr +++ b/testsuite/tests/rename/should_fail/rnfail028.stderr @@ -1,2 +1,3 @@ -rnfail028.hs:2:21: The export item `module List' is not imported +rnfail028.hs:2:21: error: + The export item ‘module List’ is not imported diff --git a/testsuite/tests/rename/should_fail/rnfail040.stderr b/testsuite/tests/rename/should_fail/rnfail040.stderr index 1d49aed612..f16607c07f 100644 --- a/testsuite/tests/rename/should_fail/rnfail040.stderr +++ b/testsuite/tests/rename/should_fail/rnfail040.stderr @@ -3,7 +3,7 @@ rnfail040.hs:7:12: error: Conflicting exports for ‘nub’: ‘module M’ exports ‘M.nub’ imported from ‘Data.List’ at rnfail040.hs:10:2-22 - (and originally defined in ‘base-4.10.0.0:Data.OldList’) + (and originally defined in ‘base-4.12.0.0:Data.OldList’) ‘module M’ exports ‘T.nub’ imported from ‘Rnfail040_A’ at rnfail040.hs:11:2-24 (and originally defined at Rnfail040_A.hs:2:3-5) diff --git a/testsuite/tests/rename/should_fail/rnfail044.stderr b/testsuite/tests/rename/should_fail/rnfail044.stderr index 6dcf2ca8f9..39f7b77056 100644 --- a/testsuite/tests/rename/should_fail/rnfail044.stderr +++ b/testsuite/tests/rename/should_fail/rnfail044.stderr @@ -1,7 +1,8 @@ rnfail044.hs:5:12: error: Ambiguous occurrence ‘splitAt’ - It could refer to either ‘Data.List.splitAt’, - imported from ‘Prelude’ at rnfail044.hs:5:8 - (and originally defined in ‘GHC.List’) - or ‘A.splitAt’, defined at rnfail044.hs:8:3 + It could refer to + either ‘Prelude.splitAt’, + imported from ‘Prelude’ at rnfail044.hs:5:8 + (and originally defined in ‘GHC.List’) + or ‘A.splitAt’, defined at rnfail044.hs:8:3 diff --git a/testsuite/tests/rename/should_fail/rnfail055.stderr b/testsuite/tests/rename/should_fail/rnfail055.stderr index 7fc5d80bad..b9ba174519 100644 --- a/testsuite/tests/rename/should_fail/rnfail055.stderr +++ b/testsuite/tests/rename/should_fail/rnfail055.stderr @@ -71,10 +71,8 @@ RnFail055.hs-boot:25:1: error: Type constructor ‘T7’ has conflicting definitions in the module and its hs-boot file Main module: type role T7 phantom - data T7 a where - T7 :: a1 -> T7 a - Boot file: data T7 a where - T7 :: a -> T7 a + data T7 a = forall a1. T7 a1 + Boot file: data T7 a = forall b. T7 a The roles do not match. Roles on abstract types default to ‘representational’ in boot files. The constructors do not match: The types for ‘T7’ differ diff --git a/testsuite/tests/roles/should_compile/Roles1.stderr b/testsuite/tests/roles/should_compile/Roles1.stderr index dd2f16d463..4eae0a4754 100644 --- a/testsuite/tests/roles/should_compile/Roles1.stderr +++ b/testsuite/tests/roles/should_compile/Roles1.stderr @@ -21,8 +21,8 @@ TYPE CONSTRUCTORS data T7 (a :: k) b = K7 b COERCION AXIOMS Dependent modules: [] -Dependent packages: [base-4.10.0.0, ghc-prim-0.5.1.0, - integer-gmp-1.0.0.1] +Dependent packages: [base-4.12.0.0, ghc-prim-0.5.3, + integer-gmp-1.0.2.0] ==================== Typechecker ==================== Roles1.$tcT7 @@ -137,36 +137,37 @@ Roles1.$tc'K1 (GHC.Types.TrNameS "'K1"#) 1 $krep -$krep [InlPrag=[~]] = GHC.Types.KindRepVar 1 -$krep [InlPrag=[~]] = GHC.Types.KindRepVar 0 -$krep [InlPrag=[~]] = GHC.Types.KindRepVar 0 -$krep [InlPrag=[~]] = GHC.Types.KindRepVar 1 -$krep [InlPrag=[~]] = GHC.Types.KindRepVar 2 -$krep [InlPrag=[~]] = GHC.Types.KindRepApp $krep $krep -$krep [InlPrag=[~]] +$krep [InlPrag=NOUSERINLINE[~]] = GHC.Types.KindRepVar 1 +$krep [InlPrag=NOUSERINLINE[~]] = GHC.Types.KindRepVar 0 +$krep [InlPrag=NOUSERINLINE[~]] = GHC.Types.KindRepVar 0 +$krep [InlPrag=NOUSERINLINE[~]] = GHC.Types.KindRepVar 1 +$krep [InlPrag=NOUSERINLINE[~]] = GHC.Types.KindRepVar 2 +$krep [InlPrag=NOUSERINLINE[~]] = GHC.Types.KindRepApp $krep $krep +$krep [InlPrag=NOUSERINLINE[~]] = GHC.Types.KindRepFun $krep GHC.Types.krep$*Arr* -$krep [InlPrag=[~]] = GHC.Types.KindRepFun $krep GHC.Types.krep$* -$krep [InlPrag=[~]] = GHC.Types.KindRepFun $krep $krep -$krep [InlPrag=[~]] = GHC.Types.KindRepFun $krep $krep -$krep [InlPrag=[~]] = GHC.Types.KindRepFun $krep $krep -$krep [InlPrag=[~]] = GHC.Types.KindRepFun $krep $krep -$krep [InlPrag=[~]] = GHC.Types.KindRepFun $krep $krep -$krep [InlPrag=[~]] +$krep [InlPrag=NOUSERINLINE[~]] + = GHC.Types.KindRepFun $krep GHC.Types.krep$* +$krep [InlPrag=NOUSERINLINE[~]] = GHC.Types.KindRepFun $krep $krep +$krep [InlPrag=NOUSERINLINE[~]] = GHC.Types.KindRepFun $krep $krep +$krep [InlPrag=NOUSERINLINE[~]] = GHC.Types.KindRepFun $krep $krep +$krep [InlPrag=NOUSERINLINE[~]] = GHC.Types.KindRepFun $krep $krep +$krep [InlPrag=NOUSERINLINE[~]] = GHC.Types.KindRepFun $krep $krep +$krep [InlPrag=NOUSERINLINE[~]] = GHC.Types.KindRepFun GHC.Types.krep$*Arr* GHC.Types.krep$*Arr* -$krep [InlPrag=[~]] +$krep [InlPrag=NOUSERINLINE[~]] = GHC.Types.KindRepTyConApp Roles1.$tcT7 ((:) $krep ((:) $krep ((:) $krep []))) -$krep [InlPrag=[~]] +$krep [InlPrag=NOUSERINLINE[~]] = GHC.Types.KindRepTyConApp Roles1.$tcT6 ((:) $krep ((:) $krep [])) -$krep [InlPrag=[~]] +$krep [InlPrag=NOUSERINLINE[~]] = GHC.Types.KindRepTyConApp Roles1.$tcT4 ((:) $krep ((:) $krep [])) -$krep [InlPrag=[~]] +$krep [InlPrag=NOUSERINLINE[~]] = GHC.Types.KindRepTyConApp Roles1.$tcT3 ((:) $krep ((:) $krep [])) -$krep [InlPrag=[~]] +$krep [InlPrag=NOUSERINLINE[~]] = GHC.Types.KindRepTyConApp Roles1.$tcT5 ((:) $krep []) -$krep [InlPrag=[~]] +$krep [InlPrag=NOUSERINLINE[~]] = GHC.Types.KindRepTyConApp Roles1.$tcT2 ((:) $krep []) -$krep [InlPrag=[~]] +$krep [InlPrag=NOUSERINLINE[~]] = GHC.Types.KindRepTyConApp Roles1.$tcT1 ((:) $krep []) Roles1.$trModule = GHC.Types.Module diff --git a/testsuite/tests/roles/should_compile/Roles13.stderr b/testsuite/tests/roles/should_compile/Roles13.stderr index f4b44a28c4..29b7b2de26 100644 --- a/testsuite/tests/roles/should_compile/Roles13.stderr +++ b/testsuite/tests/roles/should_compile/Roles13.stderr @@ -5,67 +5,67 @@ Result size of Tidy Core -- RHS size: {terms: 2, types: 2, coercions: 0, joins: 0/0} convert1 :: Wrap Age -> Wrap Age -[GblId, Arity=1, Caf=NoCafRefs] +[GblId, Arity=1, Caf=NoCafRefs, Unf=OtherCon []] convert1 = \ (ds :: Wrap Age) -> ds -- RHS size: {terms: 1, types: 0, coercions: 5, joins: 0/0} convert :: Wrap Age -> Int -[GblId, Arity=1, Caf=NoCafRefs] +[GblId, Arity=1, Caf=NoCafRefs, Unf=OtherCon []] convert = convert1 - `cast` (<Wrap Age>_R -> Roles13.N:Wrap[0] Roles13.N:Age[0] - :: (Wrap Age -> Wrap Age :: *) ~R# (Wrap Age -> Int :: *)) + `cast` (<Wrap Age>_R ->_R Roles13.N:Wrap[0] (Roles13.N:Age[0]) + :: (Wrap Age -> Wrap Age) ~R# (Wrap Age -> Int)) -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} $trModule1 :: GHC.Prim.Addr# -[GblId, Caf=NoCafRefs] +[GblId, Caf=NoCafRefs, Unf=OtherCon []] $trModule1 = "main"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} $trModule2 :: GHC.Types.TrName -[GblId, Caf=NoCafRefs] +[GblId, Caf=NoCafRefs, Unf=OtherCon []] $trModule2 = GHC.Types.TrNameS $trModule1 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} $trModule3 :: GHC.Prim.Addr# -[GblId, Caf=NoCafRefs] +[GblId, Caf=NoCafRefs, Unf=OtherCon []] $trModule3 = "Roles13"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} $trModule4 :: GHC.Types.TrName -[GblId, Caf=NoCafRefs] +[GblId, Caf=NoCafRefs, Unf=OtherCon []] $trModule4 = GHC.Types.TrNameS $trModule3 -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} Roles13.$trModule :: GHC.Types.Module -[GblId, Caf=NoCafRefs] +[GblId, Caf=NoCafRefs, Unf=OtherCon []] Roles13.$trModule = GHC.Types.Module $trModule2 $trModule4 -- RHS size: {terms: 3, types: 1, coercions: 0, joins: 0/0} $krep :: GHC.Types.KindRep -[GblId] +[GblId, Unf=OtherCon []] $krep = GHC.Types.KindRepTyConApp GHC.Types.$tcInt (GHC.Types.[] @ GHC.Types.KindRep) -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} $krep1 :: GHC.Types.KindRep -[GblId, Caf=NoCafRefs] +[GblId, Caf=NoCafRefs, Unf=OtherCon []] $krep1 = GHC.Types.KindRepVar 0# -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} $tcAge1 :: GHC.Prim.Addr# -[GblId, Caf=NoCafRefs] +[GblId, Caf=NoCafRefs, Unf=OtherCon []] $tcAge1 = "Age"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} $tcAge2 :: GHC.Types.TrName -[GblId, Caf=NoCafRefs] +[GblId, Caf=NoCafRefs, Unf=OtherCon []] $tcAge2 = GHC.Types.TrNameS $tcAge1 -- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} Roles13.$tcAge :: GHC.Types.TyCon -[GblId] +[GblId, Unf=OtherCon []] Roles13.$tcAge = GHC.Types.TyCon 3456257068627873222## @@ -77,29 +77,29 @@ Roles13.$tcAge -- RHS size: {terms: 3, types: 1, coercions: 0, joins: 0/0} $krep2 :: GHC.Types.KindRep -[GblId] +[GblId, Unf=OtherCon []] $krep2 = GHC.Types.KindRepTyConApp Roles13.$tcAge (GHC.Types.[] @ GHC.Types.KindRep) -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} $krep3 :: GHC.Types.KindRep -[GblId] +[GblId, Unf=OtherCon []] $krep3 = GHC.Types.KindRepFun $krep $krep2 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} $tc'MkAge1 :: GHC.Prim.Addr# -[GblId, Caf=NoCafRefs] +[GblId, Caf=NoCafRefs, Unf=OtherCon []] $tc'MkAge1 = "'MkAge"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} $tc'MkAge2 :: GHC.Types.TrName -[GblId, Caf=NoCafRefs] +[GblId, Caf=NoCafRefs, Unf=OtherCon []] $tc'MkAge2 = GHC.Types.TrNameS $tc'MkAge1 -- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} Roles13.$tc'MkAge :: GHC.Types.TyCon -[GblId] +[GblId, Unf=OtherCon []] Roles13.$tc'MkAge = GHC.Types.TyCon 18264039750958872441## @@ -111,17 +111,17 @@ Roles13.$tc'MkAge -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} $tcWrap1 :: GHC.Prim.Addr# -[GblId, Caf=NoCafRefs] +[GblId, Caf=NoCafRefs, Unf=OtherCon []] $tcWrap1 = "Wrap"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} $tcWrap2 :: GHC.Types.TrName -[GblId, Caf=NoCafRefs] +[GblId, Caf=NoCafRefs, Unf=OtherCon []] $tcWrap2 = GHC.Types.TrNameS $tcWrap1 -- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} Roles13.$tcWrap :: GHC.Types.TyCon -[GblId] +[GblId, Unf=OtherCon []] Roles13.$tcWrap = GHC.Types.TyCon 13773534096961634492## @@ -133,34 +133,34 @@ Roles13.$tcWrap -- RHS size: {terms: 3, types: 2, coercions: 0, joins: 0/0} $krep4 :: [GHC.Types.KindRep] -[GblId, Caf=NoCafRefs] +[GblId, Caf=NoCafRefs, Unf=OtherCon []] $krep4 = GHC.Types.: @ GHC.Types.KindRep $krep1 (GHC.Types.[] @ GHC.Types.KindRep) -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} $krep5 :: GHC.Types.KindRep -[GblId] +[GblId, Unf=OtherCon []] $krep5 = GHC.Types.KindRepTyConApp Roles13.$tcWrap $krep4 -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} $krep6 :: GHC.Types.KindRep -[GblId] +[GblId, Unf=OtherCon []] $krep6 = GHC.Types.KindRepFun $krep1 $krep5 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} $tc'MkWrap1 :: GHC.Prim.Addr# -[GblId, Caf=NoCafRefs] +[GblId, Caf=NoCafRefs, Unf=OtherCon []] $tc'MkWrap1 = "'MkWrap"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} $tc'MkWrap2 :: GHC.Types.TrName -[GblId, Caf=NoCafRefs] +[GblId, Caf=NoCafRefs, Unf=OtherCon []] $tc'MkWrap2 = GHC.Types.TrNameS $tc'MkWrap1 -- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} Roles13.$tc'MkWrap :: GHC.Types.TyCon -[GblId] +[GblId, Unf=OtherCon []] Roles13.$tc'MkWrap = GHC.Types.TyCon 15580677875333883466## diff --git a/testsuite/tests/roles/should_compile/Roles14.stderr b/testsuite/tests/roles/should_compile/Roles14.stderr index 432d936d9e..86434f1ed1 100644 --- a/testsuite/tests/roles/should_compile/Roles14.stderr +++ b/testsuite/tests/roles/should_compile/Roles14.stderr @@ -8,8 +8,8 @@ TYPE CONSTRUCTORS COERCION AXIOMS axiom Roles12.N:C2 :: C2 a = a -> a -- Defined at Roles14.hs:6:1 Dependent modules: [] -Dependent packages: [base-4.10.0.0, ghc-prim-0.5.1.0, - integer-gmp-1.0.0.1] +Dependent packages: [base-4.12.0.0, ghc-prim-0.5.3, + integer-gmp-1.0.2.0] ==================== Typechecker ==================== Roles12.$tcC2 @@ -28,13 +28,14 @@ Roles12.$tc'C:C2 (GHC.Types.TrNameS "'C:C2"#) 1 $krep -$krep [InlPrag=[~]] = GHC.Types.KindRepVar 0 -$krep [InlPrag=[~]] = GHC.Types.KindRepFun $krep $krep -$krep [InlPrag=[~]] = GHC.Types.KindRepFun $krep $krep -$krep [InlPrag=[~]] = GHC.Types.KindRepFun GHC.Types.krep$* $krep -$krep [InlPrag=[~]] +$krep [InlPrag=NOUSERINLINE[~]] = GHC.Types.KindRepVar 0 +$krep [InlPrag=NOUSERINLINE[~]] = GHC.Types.KindRepFun $krep $krep +$krep [InlPrag=NOUSERINLINE[~]] = GHC.Types.KindRepFun $krep $krep +$krep [InlPrag=NOUSERINLINE[~]] + = GHC.Types.KindRepFun GHC.Types.krep$* $krep +$krep [InlPrag=NOUSERINLINE[~]] = GHC.Types.KindRepTyConApp GHC.Types.$tcConstraint [] -$krep [InlPrag=[~]] +$krep [InlPrag=NOUSERINLINE[~]] = GHC.Types.KindRepTyConApp Roles12.$tcC2 ((:) $krep []) Roles12.$trModule = GHC.Types.Module diff --git a/testsuite/tests/roles/should_compile/Roles2.stderr b/testsuite/tests/roles/should_compile/Roles2.stderr index 6f77024162..244b32feb7 100644 --- a/testsuite/tests/roles/should_compile/Roles2.stderr +++ b/testsuite/tests/roles/should_compile/Roles2.stderr @@ -7,8 +7,8 @@ TYPE CONSTRUCTORS data T2 a = K2 (FunPtr a) COERCION AXIOMS Dependent modules: [] -Dependent packages: [base-4.10.0.0, ghc-prim-0.5.1.0, - integer-gmp-1.0.0.1] +Dependent packages: [base-4.12.0.0, ghc-prim-0.5.3, + integer-gmp-1.0.2.0] ==================== Typechecker ==================== Roles2.$tcT2 @@ -43,16 +43,16 @@ Roles2.$tc'K1 (GHC.Types.TrNameS "'K1"#) 1 $krep -$krep [InlPrag=[~]] = GHC.Types.KindRepVar 0 -$krep [InlPrag=[~]] = GHC.Types.KindRepFun $krep $krep -$krep [InlPrag=[~]] = GHC.Types.KindRepFun $krep $krep -$krep [InlPrag=[~]] +$krep [InlPrag=NOUSERINLINE[~]] = GHC.Types.KindRepVar 0 +$krep [InlPrag=NOUSERINLINE[~]] = GHC.Types.KindRepFun $krep $krep +$krep [InlPrag=NOUSERINLINE[~]] = GHC.Types.KindRepFun $krep $krep +$krep [InlPrag=NOUSERINLINE[~]] = GHC.Types.KindRepTyConApp GHC.Ptr.$tcFunPtr ((:) $krep []) -$krep [InlPrag=[~]] +$krep [InlPrag=NOUSERINLINE[~]] = GHC.Types.KindRepTyConApp Roles2.$tcT2 ((:) $krep []) -$krep [InlPrag=[~]] +$krep [InlPrag=NOUSERINLINE[~]] = GHC.Types.KindRepTyConApp GHC.Types.$tcIO ((:) $krep []) -$krep [InlPrag=[~]] +$krep [InlPrag=NOUSERINLINE[~]] = GHC.Types.KindRepTyConApp Roles2.$tcT1 ((:) $krep []) Roles2.$trModule = GHC.Types.Module diff --git a/testsuite/tests/roles/should_compile/Roles3.stderr b/testsuite/tests/roles/should_compile/Roles3.stderr index 4a9299772d..aa2a07f459 100644 --- a/testsuite/tests/roles/should_compile/Roles3.stderr +++ b/testsuite/tests/roles/should_compile/Roles3.stderr @@ -29,8 +29,8 @@ COERCION AXIOMS axiom Roles3.N:C4 :: C4 a b = a -> F4 b -> F4 b -- Defined at Roles3.hs:18:1 Dependent modules: [] -Dependent packages: [base-4.10.0.0, ghc-prim-0.5.1.0, - integer-gmp-1.0.0.1] +Dependent packages: [base-4.12.0.0, ghc-prim-0.5.3, + integer-gmp-1.0.2.0] ==================== Typechecker ==================== Roles3.$tcC4 @@ -81,24 +81,25 @@ Roles3.$tc'C:C1 (GHC.Types.TrNameS "'C:C1"#) 1 $krep -$krep [InlPrag=[~]] = GHC.Types.KindRepVar 0 -$krep [InlPrag=[~]] = GHC.Types.KindRepVar 1 -$krep [InlPrag=[~]] = GHC.Types.KindRepFun $krep $krep -$krep [InlPrag=[~]] = GHC.Types.KindRepFun $krep $krep -$krep [InlPrag=[~]] = GHC.Types.KindRepFun $krep $krep -$krep [InlPrag=[~]] = GHC.Types.KindRepFun $krep $krep -$krep [InlPrag=[~]] = GHC.Types.KindRepFun $krep $krep -$krep [InlPrag=[~]] = GHC.Types.KindRepFun GHC.Types.krep$* $krep -$krep [InlPrag=[~]] = GHC.Types.KindRepFun GHC.Types.krep$* $krep -$krep [InlPrag=[~]] +$krep [InlPrag=NOUSERINLINE[~]] = GHC.Types.KindRepVar 0 +$krep [InlPrag=NOUSERINLINE[~]] = GHC.Types.KindRepVar 1 +$krep [InlPrag=NOUSERINLINE[~]] = GHC.Types.KindRepFun $krep $krep +$krep [InlPrag=NOUSERINLINE[~]] = GHC.Types.KindRepFun $krep $krep +$krep [InlPrag=NOUSERINLINE[~]] = GHC.Types.KindRepFun $krep $krep +$krep [InlPrag=NOUSERINLINE[~]] = GHC.Types.KindRepFun $krep $krep +$krep [InlPrag=NOUSERINLINE[~]] = GHC.Types.KindRepFun $krep $krep +$krep [InlPrag=NOUSERINLINE[~]] + = GHC.Types.KindRepFun GHC.Types.krep$* $krep +$krep [InlPrag=NOUSERINLINE[~]] + = GHC.Types.KindRepFun GHC.Types.krep$* $krep +$krep [InlPrag=NOUSERINLINE[~]] = GHC.Types.KindRepTyConApp GHC.Types.$tcConstraint [] -$krep [InlPrag=[~]] +$krep [InlPrag=NOUSERINLINE[~]] = GHC.Types.KindRepTyConApp - Data.Type.Equality.$tc~ - ((:) GHC.Types.krep$* ((:) $krep ((:) $krep []))) -$krep [InlPrag=[~]] + GHC.Types.$tc~ ((:) GHC.Types.krep$* ((:) $krep ((:) $krep []))) +$krep [InlPrag=NOUSERINLINE[~]] = GHC.Types.KindRepTyConApp Roles3.$tcC2 ((:) $krep ((:) $krep [])) -$krep [InlPrag=[~]] +$krep [InlPrag=NOUSERINLINE[~]] = GHC.Types.KindRepTyConApp Roles3.$tcC1 ((:) $krep []) Roles3.$trModule = GHC.Types.Module diff --git a/testsuite/tests/roles/should_compile/Roles4.stderr b/testsuite/tests/roles/should_compile/Roles4.stderr index 7a61af6f5a..9f8803d11d 100644 --- a/testsuite/tests/roles/should_compile/Roles4.stderr +++ b/testsuite/tests/roles/should_compile/Roles4.stderr @@ -14,8 +14,8 @@ COERCION AXIOMS axiom Roles4.N:C3 :: C3 a = a -> Syn1 a -- Defined at Roles4.hs:11:1 Dependent modules: [] -Dependent packages: [base-4.10.0.0, ghc-prim-0.5.1.0, - integer-gmp-1.0.0.1] +Dependent packages: [base-4.12.0.0, ghc-prim-0.5.3, + integer-gmp-1.0.2.0] ==================== Typechecker ==================== Roles4.$tcC3 @@ -50,19 +50,20 @@ Roles4.$tc'C:C1 (GHC.Types.TrNameS "'C:C1"#) 1 $krep -$krep [InlPrag=[~]] = GHC.Types.KindRepVar 0 -$krep [InlPrag=[~]] = GHC.Types.KindRepFun $krep $krep -$krep [InlPrag=[~]] = GHC.Types.KindRepFun $krep $krep -$krep [InlPrag=[~]] = GHC.Types.KindRepFun $krep $krep -$krep [InlPrag=[~]] = GHC.Types.KindRepFun $krep $krep -$krep [InlPrag=[~]] = GHC.Types.KindRepFun GHC.Types.krep$* $krep -$krep [InlPrag=[~]] +$krep [InlPrag=NOUSERINLINE[~]] = GHC.Types.KindRepVar 0 +$krep [InlPrag=NOUSERINLINE[~]] = GHC.Types.KindRepFun $krep $krep +$krep [InlPrag=NOUSERINLINE[~]] = GHC.Types.KindRepFun $krep $krep +$krep [InlPrag=NOUSERINLINE[~]] = GHC.Types.KindRepFun $krep $krep +$krep [InlPrag=NOUSERINLINE[~]] = GHC.Types.KindRepFun $krep $krep +$krep [InlPrag=NOUSERINLINE[~]] + = GHC.Types.KindRepFun GHC.Types.krep$* $krep +$krep [InlPrag=NOUSERINLINE[~]] = GHC.Types.KindRepTyConApp GHC.Types.$tc[] ((:) $krep []) -$krep [InlPrag=[~]] +$krep [InlPrag=NOUSERINLINE[~]] = GHC.Types.KindRepTyConApp GHC.Types.$tcConstraint [] -$krep [InlPrag=[~]] +$krep [InlPrag=NOUSERINLINE[~]] = GHC.Types.KindRepTyConApp Roles4.$tcC3 ((:) $krep []) -$krep [InlPrag=[~]] +$krep [InlPrag=NOUSERINLINE[~]] = GHC.Types.KindRepTyConApp Roles4.$tcC1 ((:) $krep []) Roles4.$trModule = GHC.Types.Module diff --git a/testsuite/tests/roles/should_compile/T14101.hs b/testsuite/tests/roles/should_compile/T14101.hs new file mode 100644 index 0000000000..3a23b5af70 --- /dev/null +++ b/testsuite/tests/roles/should_compile/T14101.hs @@ -0,0 +1,10 @@ +{-# LANGUAGE RoleAnnotations #-} +module T14101 where + +type role Array representational +data Array a + +type Arr = Array + +data Foo a = Foo (Arr a) +type role Foo representational diff --git a/testsuite/tests/roles/should_compile/T8958.stderr b/testsuite/tests/roles/should_compile/T8958.stderr index 117cea60b4..db4e8330de 100644 --- a/testsuite/tests/roles/should_compile/T8958.stderr +++ b/testsuite/tests/roles/should_compile/T8958.stderr @@ -16,8 +16,8 @@ INSTANCES -- Defined at T8958.hs:10:10 instance [incoherent] Nominal a -- Defined at T8958.hs:7:10 Dependent modules: [] -Dependent packages: [base-4.10.0.0, ghc-prim-0.5.1.0, - integer-gmp-1.0.0.1] +Dependent packages: [base-4.12.0.0, ghc-prim-0.5.3, + integer-gmp-1.0.2.0] ==================== Typechecker ==================== T8958.$tcMap @@ -68,32 +68,33 @@ T8958.$tc'C:Nominal (GHC.Types.TrNameS "'C:Nominal"#) 1 $krep -$krep [InlPrag=[~]] = GHC.Types.KindRepVar 0 -$krep [InlPrag=[~]] = GHC.Types.KindRepVar 1 -$krep [InlPrag=[~]] = GHC.Types.KindRepFun $krep $krep -$krep [InlPrag=[~]] = GHC.Types.KindRepFun GHC.Types.krep$* $krep -$krep [InlPrag=[~]] +$krep [InlPrag=NOUSERINLINE[~]] = GHC.Types.KindRepVar 0 +$krep [InlPrag=NOUSERINLINE[~]] = GHC.Types.KindRepVar 1 +$krep [InlPrag=NOUSERINLINE[~]] = GHC.Types.KindRepFun $krep $krep +$krep [InlPrag=NOUSERINLINE[~]] + = GHC.Types.KindRepFun GHC.Types.krep$* $krep +$krep [InlPrag=NOUSERINLINE[~]] = GHC.Types.KindRepTyConApp GHC.Tuple.$tc(,) ((:) @ GHC.Types.KindRep $krep ((:) @ GHC.Types.KindRep $krep [] @ GHC.Types.KindRep)) -$krep [InlPrag=[~]] +$krep [InlPrag=NOUSERINLINE[~]] = GHC.Types.KindRepTyConApp T8958.$tcMap ((:) @ GHC.Types.KindRep $krep ((:) @ GHC.Types.KindRep $krep [] @ GHC.Types.KindRep)) -$krep [InlPrag=[~]] +$krep [InlPrag=NOUSERINLINE[~]] = GHC.Types.KindRepTyConApp GHC.Types.$tc[] ((:) @ GHC.Types.KindRep $krep [] @ GHC.Types.KindRep) -$krep [InlPrag=[~]] +$krep [InlPrag=NOUSERINLINE[~]] = GHC.Types.KindRepTyConApp GHC.Types.$tcConstraint [] @ GHC.Types.KindRep -$krep [InlPrag=[~]] +$krep [InlPrag=NOUSERINLINE[~]] = GHC.Types.KindRepTyConApp T8958.$tcRepresentational ((:) @ GHC.Types.KindRep $krep [] @ GHC.Types.KindRep) -$krep [InlPrag=[~]] +$krep [InlPrag=NOUSERINLINE[~]] = GHC.Types.KindRepTyConApp T8958.$tcNominal ((:) @ GHC.Types.KindRep $krep [] @ GHC.Types.KindRep) @@ -103,7 +104,7 @@ T8958.$trModule AbsBinds [a] [] {Exports: [T8958.$fRepresentationala <= $dRepresentational wrap: <>] - Exported types: T8958.$fRepresentationala [InlPrag=CONLIKE] + Exported types: T8958.$fRepresentationala [InlPrag=NOUSERINLINE CONLIKE] :: forall a. Representational a [LclIdX[DFunId], Unf=DFun: \ (@ a) -> T8958.C:Representational TYPE: a] @@ -112,7 +113,7 @@ AbsBinds [a] [] AbsBinds [a] [] {Exports: [T8958.$fNominala <= $dNominal wrap: <>] - Exported types: T8958.$fNominala [InlPrag=CONLIKE] + Exported types: T8958.$fNominala [InlPrag=NOUSERINLINE CONLIKE] :: forall a. Nominal a [LclIdX[DFunId], Unf=DFun: \ (@ a) -> T8958.C:Nominal TYPE: a] Binds: $dNominal = T8958.C:Nominal @ a diff --git a/testsuite/tests/roles/should_compile/all.T b/testsuite/tests/roles/should_compile/all.T index c0b0d827c9..8d7c31f4da 100644 --- a/testsuite/tests/roles/should_compile/all.T +++ b/testsuite/tests/roles/should_compile/all.T @@ -7,3 +7,4 @@ test('Roles14', only_ways('normal'), compile, ['-ddump-tc -dsuppress-uniques']) test('T8958', [normalise_fun(normalise_errmsg), only_ways('normal')], compile, ['-ddump-tc -dsuppress-uniques -fprint-typechecker-elaboration']) test('T10263', normal, compile, ['']) test('T9204b', [], multimod_compile, ['T9204b', '-v0']) +test('T14101', normal, compile, ['']) diff --git a/testsuite/tests/rts/InternalCounters.stdout b/testsuite/tests/rts/InternalCounters.stdout new file mode 100644 index 0000000000..d764d7bc19 --- /dev/null +++ b/testsuite/tests/rts/InternalCounters.stdout @@ -0,0 +1 @@ +Internal Counters:
\ No newline at end of file diff --git a/testsuite/tests/rts/Makefile b/testsuite/tests/rts/Makefile index a6d248201b..bf7e163cf3 100644 --- a/testsuite/tests/rts/Makefile +++ b/testsuite/tests/rts/Makefile @@ -48,13 +48,13 @@ T5423: .PHONY: T9405 T9405: @'$(TEST_HC)' $(TEST_HC_OPTS) -ticky -rtsopts T9405.hs; \ - ./T9405 +RTS -rT9405.ticky & \ - sleep 0.2; \ - kill -2 $$!; \ - wait $$!; \ - [ -e T9405.ticky ] || echo "Error: Ticky profile doesn't exist"; \ - [ -s T9405.ticky ] || echo "Error: Ticky profile is empty"; \ - echo Ticky-Ticky; + ./T9405 +RTS -rT9405.ticky & \ + sleep 0.2; \ + kill -2 $$!; \ + wait $$!; \ + [ -e T9405.ticky ] || echo "Error: Ticky profile doesn't exist"; \ + [ -s T9405.ticky ] || echo "Error: Ticky profile is empty"; \ + echo Ticky-Ticky; # Naming convention: 'T5423_' obj-way '_' obj-src # obj-way ::= v | dyn @@ -64,7 +64,7 @@ T9405: define run_T5435_v $(RM) T5435_load_v_$(1) T5435_v_$(1)$(exeext) -'$(TEST_HC)' $(TEST_HC_OPTS) -optc-D$(HostOS)_HOST_OS -v0 -c T5435_$(1).c -o T5435_load_v_$(1).o +'$(TEST_HC)' $(TEST_HC_OPTS) -optc-D$(HostOS)_HOST_OS -optc-DLOAD_CONSTR=$(2) -v0 -c T5435_$(1).c -o T5435_load_v_$(1).o '$(TEST_HC)' $(TEST_HC_OPTS) -v0 T5435.hs -osuf main_v_$(1)_o -o T5435_v_$(1)$(exeext) ./T5435_v_$(1) v ./T5435_load_v_$(1).o endef @@ -78,11 +78,13 @@ endef .PHONY: T5435_v_gcc T5435_v_gcc : - $(call run_T5435_v,gcc) + $(call run_T5435_v,gcc,0) -.PHONY: T5435_v_asm -T5435_v_asm : - $(call run_T5435_v,asm) +.PHONY: T5435_v_asm_a T5435_v_asm_b +T5435_v_asm_a : + $(call run_T5435_v,asm,0) +T5435_v_asm_b : + $(call run_T5435_v,asm,1) .PHONY: T5435_dyn_gcc T5435_dyn_gcc : @@ -174,3 +176,17 @@ T11788: .PHONY: T12497 T12497: echo main | "$(TEST_HC)" $(filter-out -rtsopts, $(TEST_HC_OPTS_INTERACTIVE)) T12497.hs + +.PHONY: T13617 +T13617: + "$(TEST_CC)" -O3 -ffast-math -ftree-vectorize -c T13617.c -o T13617_sse.o + echo main | "$(TEST_HC)" $(TEST_HC_OPTS_INTERACTIVE) T13617.hs T13617_sse.o + +.PHONY: T14695 +T14695: + echo ":quit" | LD_LIBRARY_PATH="foo:" "$(TEST_HC)" $(filter-out -rtsopts, $(TEST_HC_OPTS_INTERACTIVE)) + +.PHONY: InternalCounters +InternalCounters: + "$(TEST_HC)" +RTS -s --internal-counters -RTS 2>&1 | grep "Internal Counters" + -"$(TEST_HC)" +RTS -s -RTS 2>&1 | grep "Internal Counters" diff --git a/testsuite/tests/rts/T13082/all.T b/testsuite/tests/rts/T13082/all.T index f048ce4ddd..9580bc40b8 100644 --- a/testsuite/tests/rts/T13082/all.T +++ b/testsuite/tests/rts/T13082/all.T @@ -1,7 +1,24 @@ +import string +import re + +#-------------------------------------- +# Python normalization functions +#-------------------------------------- + +def normalise_search_dirs (str): + str = re.sub(r"directories searched:\s+.+$", + r"directories searched: (none)", str, flags=re.MULTILINE) + str = re.sub(r"^\s+[A-Za-z]:[\\\/].+$", "", str, flags=re.MULTILINE) + return str + +#-------------------------------------- +# Test functions +#-------------------------------------- test('T13082_good', [extra_files(['foo.c', 'main.hs', 'foo_dll.c']), unless(opsys('mingw32'), skip)], run_command, ['$MAKE -s --no-print-directory T13082_good']) -test('T13082_fail', [extra_files(['main.hs']), unless(opsys('mingw32'), skip)], +test('T13082_fail', [extra_files(['main.hs']), unless(opsys('mingw32'), skip), + normalise_errmsg_fun(normalise_search_dirs)], run_command, ['$MAKE -s --no-print-directory T13082_fail']) diff --git a/testsuite/tests/rts/T13617.c b/testsuite/tests/rts/T13617.c new file mode 100644 index 0000000000..6c9e714041 --- /dev/null +++ b/testsuite/tests/rts/T13617.c @@ -0,0 +1,8 @@ +int mult(int a[], int b[], int N) +{ + int sum = 0; + for(int i=0; i<N; i++){ + sum += a[i] + b[i]; + } + return sum; +} diff --git a/testsuite/tests/rts/T13617.hs b/testsuite/tests/rts/T13617.hs new file mode 100644 index 0000000000..b3c8b35dd3 --- /dev/null +++ b/testsuite/tests/rts/T13617.hs @@ -0,0 +1,15 @@ +module Main where + +import Foreign +import Foreign.Ptr +import Foreign.C + +import Foreign.Marshal.Array + +foreign import ccall unsafe "mult" mult :: Ptr CInt -> Ptr CInt + -> CInt -> IO CInt + +main = do res <- withArray [1..10] $ \a -> + withArray [5..15] $ \b -> + mult a b 10 + print res diff --git a/testsuite/tests/rts/T13617.stdout b/testsuite/tests/rts/T13617.stdout new file mode 100644 index 0000000000..fa8f08cb6f --- /dev/null +++ b/testsuite/tests/rts/T13617.stdout @@ -0,0 +1 @@ +150 diff --git a/testsuite/tests/rts/T14497.hs b/testsuite/tests/rts/T14497.hs new file mode 100644 index 0000000000..b6473f77c9 --- /dev/null +++ b/testsuite/tests/rts/T14497.hs @@ -0,0 +1,13 @@ +module Main (main) where + +import System.Timeout + +fuc :: Integer -> Integer +fuc 0 = 1 +fuc n = n * fuc (n - 1) + +main :: IO () +main = do + let x = fuc 30000 + timeout 1000 (print x) + print (x > 0) diff --git a/testsuite/tests/rts/T14497.stdout b/testsuite/tests/rts/T14497.stdout new file mode 100644 index 0000000000..0ca95142bb --- /dev/null +++ b/testsuite/tests/rts/T14497.stdout @@ -0,0 +1 @@ +True diff --git a/testsuite/tests/rts/T14611/Makefile b/testsuite/tests/rts/T14611/Makefile new file mode 100644 index 0000000000..4fc3f86ba5 --- /dev/null +++ b/testsuite/tests/rts/T14611/Makefile @@ -0,0 +1,10 @@ +TOP=../../.. +include $(TOP)/mk/boilerplate.mk +include $(TOP)/mk/test.mk + +T14611: + '$(TEST_CC)' -c foo.c -o foo.o + '$(AR)' rsc libfoo.a foo.o + '$(TEST_HC)' -shared foo_dll.c -o libfoo-1.dll + mv libfoo-1.dll.a libfoo.dll.a + echo main | LIBRARY_PATH="$(PWD)" '$(TEST_HC)' $(TEST_HC_OPTS_INTERACTIVE) main.hs -lfoo diff --git a/testsuite/tests/rts/T14611/T14611.stdout b/testsuite/tests/rts/T14611/T14611.stdout new file mode 100644 index 0000000000..d00491fd7e --- /dev/null +++ b/testsuite/tests/rts/T14611/T14611.stdout @@ -0,0 +1 @@ +1 diff --git a/testsuite/tests/rts/T14611/all.T b/testsuite/tests/rts/T14611/all.T new file mode 100644 index 0000000000..1387e6752d --- /dev/null +++ b/testsuite/tests/rts/T14611/all.T @@ -0,0 +1,4 @@ +test('T14611', + [extra_files(['foo.c', 'main.hs', 'foo_dll.c']), + unless(opsys('mingw32'), skip)], + run_command, ['$MAKE -s --no-print-directory T14611']) diff --git a/testsuite/tests/rts/T14611/foo.c b/testsuite/tests/rts/T14611/foo.c new file mode 100644 index 0000000000..af8ad9cb50 --- /dev/null +++ b/testsuite/tests/rts/T14611/foo.c @@ -0,0 +1,6 @@ +extern int bar(); + +int foo () +{ + return bar(); +} diff --git a/testsuite/tests/rts/T14611/foo_dll.c b/testsuite/tests/rts/T14611/foo_dll.c new file mode 100644 index 0000000000..8ea6c22735 --- /dev/null +++ b/testsuite/tests/rts/T14611/foo_dll.c @@ -0,0 +1,4 @@ +int foo() +{ + return 1; +} diff --git a/testsuite/tests/rts/T14611/main.hs b/testsuite/tests/rts/T14611/main.hs new file mode 100644 index 0000000000..fbc8f5603c --- /dev/null +++ b/testsuite/tests/rts/T14611/main.hs @@ -0,0 +1,5 @@ +module Main where + +foreign import ccall "foo" c_foo :: Int + +main = print c_foo diff --git a/testsuite/tests/rts/T14702.hs b/testsuite/tests/rts/T14702.hs new file mode 100644 index 0000000000..8e07529f47 --- /dev/null +++ b/testsuite/tests/rts/T14702.hs @@ -0,0 +1,36 @@ +module Main where + +import Control.Monad +import Data.Array.IO.Safe +import Data.Word +import GHC.Stats +import System.Exit +import System.Mem + +printAlloc :: String -> IO (Word64, Word64) +printAlloc name = do + performGC + details <- gc <$> getRTSStats + let dat = (gcdetails_live_bytes details, gcdetails_mem_in_use_bytes details) + putStrLn $ name ++ ": " ++ show dat + pure dat + +allocateAndPrint :: IO () +allocateAndPrint = do + -- allocate and touch a lot of memory (4MB * 260 ~ 1GB) + memoryHog <- forM [1 .. 300] $ \_ -> + (newArray (0, 1000000) 0 :: IO (IOUArray Word Word32)) + _ <- printAlloc "with large allocation" + -- do something with memory to prevent it from being GC'ed until now + forM_ memoryHog $ \a -> void $ readArray a 0 + +main :: IO () +main = do + (firstLive, firstTotal) <- printAlloc "initial" + allocateAndPrint + (lastLive, lastTotal) <- printAlloc "final" + + -- Now there is no reason to have more memory allocated than at start + let ratio = fromIntegral lastTotal / fromIntegral firstTotal + putStrLn $ "alloc ratio " ++ show ratio + when (ratio > 1.5) $ exitFailure diff --git a/testsuite/tests/rts/T14900.hs b/testsuite/tests/rts/T14900.hs new file mode 100644 index 0000000000..bd29289e19 --- /dev/null +++ b/testsuite/tests/rts/T14900.hs @@ -0,0 +1,22 @@ +{-# LANGUAGE MagicHash, UnboxedTuples #-} + +import GHC.Compact +import GHC.Int +import GHC.Prim +import GHC.IO +import GHC.Exts + +data BA = ByteArray ByteArray# + +newByteArray :: Int -> IO BA +newByteArray (I# sz) = IO $ \s -> case newByteArray# sz s of { + (# s', arr# #) -> case unsafeFreezeByteArray# arr# s of { + (# s'', barr# #) -> (# s', ByteArray barr# #) }} + +main :: IO () +main = do + ByteArray arr1# <- fmap getCompact $ newByteArray 65000 >>= compact + ByteArray arr2# <- newByteArray 65000 + print (I# (isByteArrayPinned# arr1#)) + print (I# (isByteArrayPinned# arr2#)) + putStrLn "Finished" diff --git a/testsuite/tests/rts/T14900.stdout b/testsuite/tests/rts/T14900.stdout new file mode 100644 index 0000000000..fdc259d094 --- /dev/null +++ b/testsuite/tests/rts/T14900.stdout @@ -0,0 +1,3 @@ +1 +1 +Finished diff --git a/testsuite/tests/rts/T15261/Makefile b/testsuite/tests/rts/T15261/Makefile new file mode 100644 index 0000000000..f50b22c282 --- /dev/null +++ b/testsuite/tests/rts/T15261/Makefile @@ -0,0 +1,11 @@ +TOP=../../.. +include $(TOP)/mk/boilerplate.mk +include $(TOP)/mk/test.mk + +T15261a: + '$(TEST_HC)' $(TEST_HC_OPTS) -v0 -with-rtsopts="-t -s" --make T15261a.hs + ./T15261a +RTS --info | grep "rtsopts" + +T15261b: + '$(TEST_HC)' $(TEST_HC_OPTS) -v0 --make T15261b.hs + ./T15261b +RTS --info | grep "rtsopts" diff --git a/testsuite/tests/rts/T15261/T15261a.hs b/testsuite/tests/rts/T15261/T15261a.hs new file mode 100644 index 0000000000..4c512dc9c1 --- /dev/null +++ b/testsuite/tests/rts/T15261/T15261a.hs @@ -0,0 +1,2 @@ +main :: IO () +main = putStrLn "T15261a" diff --git a/testsuite/tests/rts/T15261/T15261a.stdout b/testsuite/tests/rts/T15261/T15261a.stdout new file mode 100644 index 0000000000..5919bb4bdd --- /dev/null +++ b/testsuite/tests/rts/T15261/T15261a.stdout @@ -0,0 +1 @@ + ,("Flag -with-rtsopts", "-t -s") diff --git a/testsuite/tests/rts/T15261/T15261b.hs b/testsuite/tests/rts/T15261/T15261b.hs new file mode 100644 index 0000000000..1304a85c6d --- /dev/null +++ b/testsuite/tests/rts/T15261/T15261b.hs @@ -0,0 +1,2 @@ +main :: IO () +main = putStrLn "T15261b" diff --git a/testsuite/tests/rts/T15261/T15261b.stdout b/testsuite/tests/rts/T15261/T15261b.stdout new file mode 100644 index 0000000000..80184e82ab --- /dev/null +++ b/testsuite/tests/rts/T15261/T15261b.stdout @@ -0,0 +1 @@ + ,("Flag -with-rtsopts", "") diff --git a/testsuite/tests/rts/T15261/all.T b/testsuite/tests/rts/T15261/all.T new file mode 100644 index 0000000000..5bc6977c26 --- /dev/null +++ b/testsuite/tests/rts/T15261/all.T @@ -0,0 +1,2 @@ +test('T15261a', normal, run_command, ['$MAKE -s --no-print-directory T15261a']) +test('T15261b', normal, run_command, ['$MAKE -s --no-print-directory T15261b']) diff --git a/testsuite/tests/rts/T5435_asm.c b/testsuite/tests/rts/T5435_asm.c index 59b53b1c3e..90813aa839 100644 --- a/testsuite/tests/rts/T5435_asm.c +++ b/testsuite/tests/rts/T5435_asm.c @@ -33,17 +33,19 @@ static void (*mod_init_func[2])(void) __attribute__(( #else /* ELF */ +#if LOAD_CONSTR == 0 static void (*const init_array[2])(void) __attribute__(( section(".init_array"), // put it in the right section used, // prevent GCC from optimizing this away aligned(sizeof(void*)) // avoid slop between GCC's preloaded initializers and ours )) = {initArray1, initArray2}; - +#else static void (*ctors[2])(void) __attribute__(( section(".ctors"), used, aligned(sizeof(void*)))) = {ctors2, ctors1}; // ctors run in reverse +#endif #endif diff --git a/testsuite/tests/rts/T5435_dyn_asm.stdout b/testsuite/tests/rts/T5435_dyn_asm.stdout index 1893d0f56a..429c314309 100644 --- a/testsuite/tests/rts/T5435_dyn_asm.stdout +++ b/testsuite/tests/rts/T5435_dyn_asm.stdout @@ -1,5 +1,3 @@ initArray1 initArray2 -ctors1 -ctors2 success diff --git a/testsuite/tests/rts/T5435_v_asm_a.stdout b/testsuite/tests/rts/T5435_v_asm_a.stdout new file mode 100644 index 0000000000..3124fa8559 --- /dev/null +++ b/testsuite/tests/rts/T5435_v_asm_a.stdout @@ -0,0 +1,3 @@ +initArray1 +initArray2 +success
\ No newline at end of file diff --git a/testsuite/tests/rts/T5435_v_asm.stdout-darwin b/testsuite/tests/rts/T5435_v_asm_a.stdout-darwin index 8827792585..8827792585 100644 --- a/testsuite/tests/rts/T5435_v_asm.stdout-darwin +++ b/testsuite/tests/rts/T5435_v_asm_a.stdout-darwin diff --git a/testsuite/tests/rts/T5435_v_asm.stdout-mingw32 b/testsuite/tests/rts/T5435_v_asm_a.stdout-mingw32 index 293bd12fb0..293bd12fb0 100644 --- a/testsuite/tests/rts/T5435_v_asm.stdout-mingw32 +++ b/testsuite/tests/rts/T5435_v_asm_a.stdout-mingw32 diff --git a/testsuite/tests/rts/T5435_v_asm_b.stdout b/testsuite/tests/rts/T5435_v_asm_b.stdout new file mode 100644 index 0000000000..318d66e12b --- /dev/null +++ b/testsuite/tests/rts/T5435_v_asm_b.stdout @@ -0,0 +1,3 @@ +ctors1 +ctors2 +success
\ No newline at end of file diff --git a/testsuite/tests/rts/T6006.stdout-mingw32 b/testsuite/tests/rts/T6006.stdout-mingw32 index 42e57fde57..962ec4b280 100644 --- a/testsuite/tests/rts/T6006.stdout-mingw32 +++ b/testsuite/tests/rts/T6006.stdout-mingw32 @@ -1,2 +1,2 @@ -"T6006.exe" +"T6006" [] diff --git a/testsuite/tests/rts/all.T b/testsuite/tests/rts/all.T index e81940479e..eb06dcc0c0 100644 --- a/testsuite/tests/rts/all.T +++ b/testsuite/tests/rts/all.T @@ -35,12 +35,12 @@ test('derefnull', when(platform('i386-apple-darwin'), [ignore_stderr, exit_code(139)]), when(platform('x86_64-apple-darwin'), [ignore_stderr, exit_code(139)]), when(platform('powerpc-apple-darwin'), [ignore_stderr, exit_code(139)]), - when(opsys('mingw32'), [exit_code(1), normalise_fun(normalise_address)]), + when(opsys('mingw32'), [ignore_stderr, exit_code(11)]), # since these test are supposed to crash the # profile report will be empty always. # so disable the check for profiling when(opsys('mingw32'), omit_ways(prof_ways))], - compile_and_run, ['']) + compile_and_run, ['-with-rtsopts="--generate-stack-traces=no"']) test('divbyzero', [# SIGFPE on Linux exit_code(136), @@ -54,7 +54,7 @@ test('divbyzero', # C programs compiled with gcc exit normally, so do we. when(platform('powerpc64-unknown-linux'), [ignore_stdout, exit_code(0)]), when(platform('powerpc64le-unknown-linux'), [ignore_stdout, exit_code(0)]), - when(opsys('mingw32'), exit_code(1)), + when(opsys('mingw32'), [ignore_stderr, exit_code(8)]), # The output under OS X is too unstable to readily compare when(platform('i386-apple-darwin'), [ignore_stderr, exit_code(136)]), when(platform('x86_64-apple-darwin'), [ignore_stderr, exit_code(136)]), @@ -63,7 +63,7 @@ test('divbyzero', # profile report will be empty always. # so disable the check for profiling when(opsys('mingw32'), omit_ways(prof_ways))], - compile_and_run, ['']) + compile_and_run, ['-with-rtsopts="--generate-stack-traces=no"']) test('outofmem', when(opsys('darwin'), skip), run_command, ['$MAKE -s --no-print-directory outofmem']) @@ -74,7 +74,9 @@ test('T2047', [ignore_stdout, extra_run_opts('+RTS -c -RTS')], # Blackhole-detection test. # Skip GHCi due to #2786 -test('T2783', [ omit_ways(['ghci']), exit_code(1) ], compile_and_run, ['']) +test('T2783', [ omit_ways(['ghci']), exit_code(1) + , expect_broken_for(2783, ['threaded1']) + ], compile_and_run, ['']) # Test the work-stealing deque implementation. We run this test in # both threaded1 (-threaded -debug) and threaded2 (-threaded) ways. @@ -97,6 +99,11 @@ test('stack003', [ omit_ways('ghci'), # uses unboxed tuples extra_run_opts('500000 +RTS -kc1k -kb100 -K96m -RTS') ], compile_and_run, ['']) +# Test that +RTS -K0 (e.g. no stack limit) parses correctly +test('stack004', [ extra_run_opts('+RTS -K0 -RTS') + , expect_broken_for(14913, ['ghci']) + ], compile_and_run, ['']) + test('atomicinc', [ c_src, only_ways(['normal','threaded1', 'threaded2']) ], compile_and_run, ['']) test('atomicxchg', [ c_src, only_ways(['threaded1', 'threaded2']) ], compile_and_run, ['']) @@ -128,10 +135,14 @@ test('T2615', # omit dyn and profiling ways, because we don't build dyn_l or p_l # variants of the RTS by default -test('traceEvent', [ omit_ways(['dyn'] + prof_ways), +test('traceEvent', [ omit_ways(['dyn', 'ghci'] + prof_ways), extra_run_opts('+RTS -ls -RTS') ], compile_and_run, ['-eventlog']) +test('traceBinaryEvent', [ omit_ways(['dyn', 'ghci'] + prof_ways), + extra_run_opts('+RTS -ls -RTS') ], + compile_and_run, ['-eventlog']) + test('T4059', [], run_command, ['$MAKE -s --no-print-directory T4059']) # Test for #4274 @@ -167,30 +178,34 @@ def checkDynAsm(actual_file, normaliser): actual_raw = read_no_crs(actual_file) actual_str = normaliser(actual_raw) actual = actual_str.split() - if actual == ['initArray1', 'initArray2', 'ctors1', 'ctors2', 'success']: - return 1 - elif actual == ['initArray1', 'initArray2', 'ctors2', 'ctors1', 'success']: - # gold seems to produce this ordering; this is slightly odd but if it's - # wrong it's not our fault. See #13883. - return 1 - elif actual == ['ctors1', 'ctors2', 'initArray1', 'initArray2', 'success']: - if_verbose(1, 'T5435_dyn_asm detected old-style dlopen, see #8458') - return 1 + if actual == ['initArray1', 'initArray2', 'success']: + return True elif opsys('darwin') and actual == ['modInitFunc1', 'modInitFunc2', 'success']: - return 1 + return True elif opsys('mingw32') and actual == ['ctors1', 'ctors2', 'success']: - return 1 + return True else: if_verbose(1, 'T5435_dyn_asm failed with %s, see all.T for details' % actual) - return 0 + return False +# T5435_v_asm got split into two tests because depending +# on the linker, .init_array and .ctors sections are loaded +# in a different order (but all entries within a section +# do get loaded in a deterministic order). So we test each +# separately now. # These should have extra_clean() arguments, but I need # to somehow extract out the name of DLLs to do that - -test('T5435_v_asm', [extra_files(['T5435.hs', 'T5435_asm.c']), +test('T5435_v_asm_a', [extra_files(['T5435.hs', 'T5435_asm.c']), when(arch('powerpc64') or arch('powerpc64le'), expect_broken(11259))], - run_command, ['$MAKE -s --no-print-directory T5435_v_asm']) + run_command, ['$MAKE -s --no-print-directory T5435_v_asm_a']) +# this one just needs to run on linux, as darwin/mingw32 are covered +# by the _a test already. +test('T5435_v_asm_b', [extra_files(['T5435.hs', 'T5435_asm.c']), + when(arch('powerpc64') or arch('powerpc64le'), + expect_broken(11259)), + when(opsys('darwin') or opsys('mingw32'), skip)], + run_command, ['$MAKE -s --no-print-directory T5435_v_asm_b']) test('T5435_v_gcc', [extra_files(['T5435.hs', 'T5435_gcc.c']), when(arch('powerpc64') or arch('powerpc64le'), expect_broken(11259))], @@ -293,7 +308,8 @@ test('ListStaticPointers', [when(doing_ghci(), extra_hc_opts('-fobject-code'))], compile_and_run, ['']) # 251 = RTS exit code for "out of memory" -test('overflow1', [ exit_code(251) ], compile_and_run, ['']) +test('overflow1', [ exit_code(251), when(wordsize(32), expect_broken(15255)) ], + compile_and_run, ['']) test('overflow2', [ exit_code(251) ], compile_and_run, ['']) test('overflow3', [ exit_code(251) ], compile_and_run, ['']) @@ -375,6 +391,43 @@ test('T12497', [ unless(opsys('mingw32'), skip) ], run_command, ['$MAKE -s --no-print-directory T12497']) -test('T12903', [when(opsys('mingw32'), skip)], compile_and_run, ['']) +test('T13617', [ unless(opsys('mingw32'), skip)], + run_command, ['$MAKE -s --no-print-directory T13617']) + +# This test sometimes produces out of sequence samples in the profasm way, but +# not reliably, so we just skip it. See ticket #15065. +# Test is being skipped on darwin due to it's flakiness. +test('T12903', [ when(opsys('mingw32'), skip) + , when(opsys('darwin'), skip) + , omit_ways(['ghci', 'profasm'])] + , compile_and_run, ['']) + test('T13832', exit_code(1), compile_and_run, ['-threaded']) test('T13894', normal, compile_and_run, ['']) +# this test fails with the profasm way on some machines but not others, +# so we just skip it. +test('T14497', [omit_ways(['profasm']), multi_cpu_race], compile_and_run, ['-O']) +test('T14695', [normal, ignore_stderr] + , run_command, ['$MAKE -s --no-print-directory T14695']) +test('T14702', [ ignore_stdout + , only_ways(['threaded1', 'threaded2']) + , extra_run_opts('+RTS -A32m -N8 -T -RTS') + ] + , compile_and_run, ['']) + +test('T14900', normal, compile_and_run, ['-package ghc-compact']) +test('InternalCounters', normal, run_command, + ['$MAKE -s --no-print-directory InternalCounters']) +test('alloccounter1', normal, compile_and_run, + [ + # avoid allocating stack chunks, which counts as + # allocation and messes up the results: + '-with-rtsopts=-k1m' + ]) + +test('nursery-chunks1', + [ extra_run_opts('4 100 +RTS -n32k -A1m -RTS') + , only_ways(['threaded1','threaded2']) + ], + compile_and_run, + ['']) diff --git a/testsuite/tests/rts/alloccounter1.hs b/testsuite/tests/rts/alloccounter1.hs new file mode 100644 index 0000000000..4b81896d2c --- /dev/null +++ b/testsuite/tests/rts/alloccounter1.hs @@ -0,0 +1,19 @@ +module Main where + +import Control.Exception +import Control.Monad +import Data.List +import System.Mem + +main = do + let + testAlloc n = do + let start = 999999 + setAllocationCounter start + evaluate (last [1..n]) + c <- getAllocationCounter + -- print (start - c) + return (start - c) + results <- forM [1..1000] testAlloc + print (sort results == results) + -- results better be in ascending order diff --git a/testsuite/tests/rts/alloccounter1.stdout b/testsuite/tests/rts/alloccounter1.stdout new file mode 100644 index 0000000000..0ca95142bb --- /dev/null +++ b/testsuite/tests/rts/alloccounter1.stdout @@ -0,0 +1 @@ +True diff --git a/testsuite/tests/rts/derefnull.stdout-i386-unknown-mingw32 b/testsuite/tests/rts/derefnull.stdout-i386-unknown-mingw32 deleted file mode 100644 index 4541b7fb28..0000000000 --- a/testsuite/tests/rts/derefnull.stdout-i386-unknown-mingw32 +++ /dev/null @@ -1 +0,0 @@ -Access violation in generated code when reading ADDRESS diff --git a/testsuite/tests/rts/derefnull.stdout-x86_64-unknown-mingw32 b/testsuite/tests/rts/derefnull.stdout-x86_64-unknown-mingw32 deleted file mode 100644 index 4541b7fb28..0000000000 --- a/testsuite/tests/rts/derefnull.stdout-x86_64-unknown-mingw32 +++ /dev/null @@ -1 +0,0 @@ -Access violation in generated code when reading ADDRESS diff --git a/testsuite/tests/rts/divbyzero.stdout-i386-unknown-mingw32 b/testsuite/tests/rts/divbyzero.stdout-i386-unknown-mingw32 deleted file mode 100644 index 466709b368..0000000000 --- a/testsuite/tests/rts/divbyzero.stdout-i386-unknown-mingw32 +++ /dev/null @@ -1 +0,0 @@ -divide by zero diff --git a/testsuite/tests/rts/divbyzero.stdout-x86_64-unknown-mingw32 b/testsuite/tests/rts/divbyzero.stdout-x86_64-unknown-mingw32 deleted file mode 100644 index 466709b368..0000000000 --- a/testsuite/tests/rts/divbyzero.stdout-x86_64-unknown-mingw32 +++ /dev/null @@ -1 +0,0 @@ -divide by zero diff --git a/testsuite/tests/dph/diophantine/Makefile b/testsuite/tests/rts/flags/Makefile index 9101fbd40a..9101fbd40a 100644 --- a/testsuite/tests/dph/diophantine/Makefile +++ b/testsuite/tests/rts/flags/Makefile diff --git a/testsuite/tests/rts/flags/T12870.hs b/testsuite/tests/rts/flags/T12870.hs new file mode 100644 index 0000000000..69086cde2b --- /dev/null +++ b/testsuite/tests/rts/flags/T12870.hs @@ -0,0 +1,7 @@ +--We check if RTS arguments are properly filtered/passed along +--by outputting them to stdout. + +import System.Environment + +main :: IO () +main = getArgs >>= putStr . show diff --git a/testsuite/tests/rts/flags/T12870_.stdout b/testsuite/tests/rts/flags/T12870_.stdout new file mode 100644 index 0000000000..1b04d8a31c --- /dev/null +++ b/testsuite/tests/rts/flags/T12870_.stdout @@ -0,0 +1 @@ +Heap overflow caught! diff --git a/testsuite/tests/rts/flags/T12870a.stdout b/testsuite/tests/rts/flags/T12870a.stdout new file mode 100644 index 0000000000..495a52faf3 --- /dev/null +++ b/testsuite/tests/rts/flags/T12870a.stdout @@ -0,0 +1 @@ +["arg1","+RTS","arg2"]
\ No newline at end of file diff --git a/testsuite/tests/rts/flags/T12870c.stderr b/testsuite/tests/rts/flags/T12870c.stderr new file mode 100644 index 0000000000..0545774941 --- /dev/null +++ b/testsuite/tests/rts/flags/T12870c.stderr @@ -0,0 +1 @@ +T12870c.exe: Most RTS options are disabled. Link with -rtsopts to enable them.
diff --git a/testsuite/tests/rts/flags/T12870d.stdout b/testsuite/tests/rts/flags/T12870d.stdout new file mode 100644 index 0000000000..495a52faf3 --- /dev/null +++ b/testsuite/tests/rts/flags/T12870d.stdout @@ -0,0 +1 @@ +["arg1","+RTS","arg2"]
\ No newline at end of file diff --git a/testsuite/tests/rts/flags/T12870e.stdout b/testsuite/tests/rts/flags/T12870e.stdout new file mode 100644 index 0000000000..4859ab454c --- /dev/null +++ b/testsuite/tests/rts/flags/T12870e.stdout @@ -0,0 +1 @@ +["+RTS","-G2","-RTS","arg1","--RTS","+RTS","arg2"]
\ No newline at end of file diff --git a/testsuite/tests/rts/flags/T12870f.stdout b/testsuite/tests/rts/flags/T12870f.stdout new file mode 100644 index 0000000000..4859ab454c --- /dev/null +++ b/testsuite/tests/rts/flags/T12870f.stdout @@ -0,0 +1 @@ +["+RTS","-G2","-RTS","arg1","--RTS","+RTS","arg2"]
\ No newline at end of file diff --git a/testsuite/tests/rts/flags/T12870g.hs b/testsuite/tests/rts/flags/T12870g.hs new file mode 100644 index 0000000000..3efd633ddd --- /dev/null +++ b/testsuite/tests/rts/flags/T12870g.hs @@ -0,0 +1,9 @@ +--We check the generation count as a way to verify an RTS argument +--was actually parsed and accepted by the RTS. + +import GHC.RTS.Flags (getGCFlags, generations) + +main :: IO () +main = do + gcFlags <- getGCFlags + putStr . show $ generations gcFlags diff --git a/testsuite/tests/rts/flags/T12870g.stdout b/testsuite/tests/rts/flags/T12870g.stdout new file mode 100644 index 0000000000..c7930257df --- /dev/null +++ b/testsuite/tests/rts/flags/T12870g.stdout @@ -0,0 +1 @@ +7
\ No newline at end of file diff --git a/testsuite/tests/rts/flags/T12870h.stdout b/testsuite/tests/rts/flags/T12870h.stdout new file mode 100644 index 0000000000..e440e5c842 --- /dev/null +++ b/testsuite/tests/rts/flags/T12870h.stdout @@ -0,0 +1 @@ +3
\ No newline at end of file diff --git a/testsuite/tests/rts/flags/all.T b/testsuite/tests/rts/flags/all.T new file mode 100644 index 0000000000..6d9368e2c1 --- /dev/null +++ b/testsuite/tests/rts/flags/all.T @@ -0,0 +1,53 @@ +# We ignore ways which depend on passing RTS arguments for simplicity and only +# run in normal way. + +# Standard handling of RTS arguments +test('T12870a', + [extra_run_opts('+RTS -G2 -RTS arg1 --RTS +RTS arg2'), extra_files(['T12870.hs']), + only_ways(['normal'])], + multimod_compile_and_run, + ['T12870', '-rtsopts']) + +test('T12870b', + [extra_run_opts('+RTS -G2 -RTS arg1 --RTS +RTS arg2'), extra_files(['T12870.hs']), + exit_code(1), ignore_stderr, only_ways(['normal'])], + multimod_compile_and_run, + ['T12870', '-rtsopts=none']) + +test('T12870c', + [extra_run_opts('+RTS -G2 -RTS arg1 --RTS +RTS arg2'), extra_files(['T12870.hs']), + exit_code(1), only_ways(['normal'])], + multimod_compile_and_run, + ['T12870', '-rtsopts=some']) + +test('T12870d', + [extra_run_opts('+RTS -G2 -RTS arg1 --RTS +RTS arg2'), extra_files(['T12870.hs']), + only_ways(['normal'])], + multimod_compile_and_run, + ['T12870', '']) + +# RTS options should be passed along to the program +test('T12870e', + [extra_run_opts('+RTS -G2 -RTS arg1 --RTS +RTS arg2'), extra_files(['T12870.hs']), + only_ways(['normal'])], + multimod_compile_and_run, + ['T12870', '-rtsopts=ignore']) + +test('T12870f', + [extra_run_opts('+RTS -G2 -RTS arg1 --RTS +RTS arg2'), extra_files(['T12870.hs']), + only_ways(['normal'])], + multimod_compile_and_run, + ['T12870', '-rtsopts=ignoreAll']) + +# Check handling of env variables +test('T12870g', + [extra_files(['T12870g.hs']), cmd_prefix('GHCRTS=-G7 '), extra_files(['T12870g.hs']), + only_ways(['normal'])], + multimod_compile_and_run, + ['T12870g', '-rtsopts -with-rtsopts="-G3"']) + +test('T12870h', + [extra_files(['T12870g.hs']), cmd_prefix('GHCRTS=-G7 '), extra_files(['T12870g.hs']), + only_ways(['normal'])], + multimod_compile_and_run, + ['T12870g', '-rtsopts=ignoreAll -with-rtsopts="-G3"']) diff --git a/testsuite/tests/rts/nursery-chunks1.hs b/testsuite/tests/rts/nursery-chunks1.hs new file mode 100644 index 0000000000..f8f9f6a7fa --- /dev/null +++ b/testsuite/tests/rts/nursery-chunks1.hs @@ -0,0 +1,12 @@ +-- Test for a bug that provoked the following assertion failure: +-- nursery-chunks1: internal error: ASSERTION FAILED: file rts/sm/Sanity.c, line 903 +module Main (main) where + +import Control.Monad +import System.Environment +import GHC.Conc + +main = do + [n,m] <- fmap read <$> getArgs + forM_ [1..n] $ \n' -> + when (sum [1.. m::Integer] > 0) $ setNumCapabilities (fromIntegral n') diff --git a/testsuite/tests/rts/stack004.hs b/testsuite/tests/rts/stack004.hs new file mode 100644 index 0000000000..4c9e337bbf --- /dev/null +++ b/testsuite/tests/rts/stack004.hs @@ -0,0 +1,10 @@ +module Main where + +import Control.Monad +import GHC.RTS.Flags + +-- Ensure that +RTS -K0 is parsed +main :: IO () +main = do + flags <- getGCFlags + unless (maxStkSize flags == 0) $ putStrLn "uh oh" diff --git a/testsuite/tests/rts/traceBinaryEvent.hs b/testsuite/tests/rts/traceBinaryEvent.hs new file mode 100644 index 0000000000..c174d44bc2 --- /dev/null +++ b/testsuite/tests/rts/traceBinaryEvent.hs @@ -0,0 +1,25 @@ +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE UnboxedTuples #-} +{-# LANGUAGE NumericUnderscores #-} +{-# LANGUAGE OverloadedStrings #-} +import Data.Word +import GHC.Base +import GHC.Ptr + +import qualified Data.ByteString as B +import qualified Data.ByteString.Unsafe as BU + +main :: IO () +main = do + traceBinaryEventIO "0123456789" + traceBinaryEventIO $ B.replicate 10 0 + traceBinaryEventIO $ B.replicate (maxSize + 1) 0 + +maxSize :: Int +maxSize = fromIntegral (maxBound :: Word16) + +traceBinaryEventIO :: B.ByteString -> IO () +traceBinaryEventIO bytes = + BU.unsafeUseAsCStringLen bytes $ \(Ptr p, I# n) -> IO $ \s -> do + case traceBinaryEvent# p n s of + s' -> (# s', () #) diff --git a/testsuite/tests/rts/traceBinaryEvent.stderr b/testsuite/tests/rts/traceBinaryEvent.stderr new file mode 100644 index 0000000000..354e919e2a --- /dev/null +++ b/testsuite/tests/rts/traceBinaryEvent.stderr @@ -0,0 +1 @@ +traceBinaryEvent: Event size exceeds EVENT_PAYLOAD_SIZE_MAX, bail out diff --git a/testsuite/tests/rts/traceEvent.hs b/testsuite/tests/rts/traceEvent.hs index a5e19a995c..06a2b19584 100644 --- a/testsuite/tests/rts/traceEvent.hs +++ b/testsuite/tests/rts/traceEvent.hs @@ -1,5 +1,10 @@ +import Data.Word import Debug.Trace main = do traceEventIO "testing" traceEventIO "%s" -- see #3874 + traceEventIO $ replicate (maxSize + 1) 'A' + +maxSize :: Int +maxSize = fromIntegral (maxBound :: Word16) diff --git a/testsuite/tests/rts/traceEvent.stderr b/testsuite/tests/rts/traceEvent.stderr new file mode 100644 index 0000000000..6a62dc79e2 --- /dev/null +++ b/testsuite/tests/rts/traceEvent.stderr @@ -0,0 +1 @@ +traceEvent: Event size exceeds EVENT_PAYLOAD_SIZE_MAX, bail out diff --git a/testsuite/tests/safeHaskell/check/Check01.stderr b/testsuite/tests/safeHaskell/check/Check01.stderr index 7b1c38f172..3140ab7f0c 100644 --- a/testsuite/tests/safeHaskell/check/Check01.stderr +++ b/testsuite/tests/safeHaskell/check/Check01.stderr @@ -1,4 +1,4 @@ [3 of 3] Compiling Check01 ( Check01.hs, Check01.o ) <no location info>: error: - The package (base-4.10.0.0) is required to be trusted but it isn't! + The package (base-4.12.0.0) is required to be trusted but it isn't! diff --git a/testsuite/tests/safeHaskell/check/Check06.stderr b/testsuite/tests/safeHaskell/check/Check06.stderr index cc33f0f6c1..6584b1e049 100644 --- a/testsuite/tests/safeHaskell/check/Check06.stderr +++ b/testsuite/tests/safeHaskell/check/Check06.stderr @@ -2,4 +2,4 @@ [2 of 2] Compiling Check06 ( Check06.hs, Check06.o ) <no location info>: error: - The package (base-4.10.0.0) is required to be trusted but it isn't! + The package (base-4.12.0.0) is required to be trusted but it isn't! diff --git a/testsuite/tests/safeHaskell/check/Check08.stderr b/testsuite/tests/safeHaskell/check/Check08.stderr index 0b53c3ae9f..36c2f255b4 100644 --- a/testsuite/tests/safeHaskell/check/Check08.stderr +++ b/testsuite/tests/safeHaskell/check/Check08.stderr @@ -3,4 +3,4 @@ [3 of 3] Compiling Check08 ( Check08.hs, Check08.o ) <no location info>: error: - The package (base-4.10.0.0) is required to be trusted but it isn't! + The package (base-4.12.0.0) is required to be trusted but it isn't! diff --git a/testsuite/tests/safeHaskell/check/Check09.stderr b/testsuite/tests/safeHaskell/check/Check09.stderr index 1dfa20fd67..f83d7d18e5 100644 --- a/testsuite/tests/safeHaskell/check/Check09.stderr +++ b/testsuite/tests/safeHaskell/check/Check09.stderr @@ -1,8 +1,8 @@ Check09.hs:4:1: error: Prelude: Can't be safely imported! - The package (base-4.10.0.0) the module resides in isn't trusted. + The package (base-4.12.0.0) the module resides in isn't trusted. Check09.hs:5:1: error: Data.ByteString.Char8: Can't be safely imported! - The package (bytestring-0.10.8.1) the module resides in isn't trusted. + The package (bytestring-0.10.8.2) the module resides in isn't trusted. diff --git a/testsuite/tests/safeHaskell/check/pkg01/ImpSafe01.stderr b/testsuite/tests/safeHaskell/check/pkg01/ImpSafe01.stderr index 4a3f86c56f..fd9bd4a6b3 100644 --- a/testsuite/tests/safeHaskell/check/pkg01/ImpSafe01.stderr +++ b/testsuite/tests/safeHaskell/check/pkg01/ImpSafe01.stderr @@ -1,4 +1,4 @@ ImpSafe01.hs:9:1: error: Data.Word: Can't be safely imported! - The package (base-4.10.0.0) the module resides in isn't trusted. + The package (base-4.12.0.0) the module resides in isn't trusted. diff --git a/testsuite/tests/safeHaskell/check/pkg01/ImpSafe04.stderr b/testsuite/tests/safeHaskell/check/pkg01/ImpSafe04.stderr index 5700fc8025..2b15817190 100644 --- a/testsuite/tests/safeHaskell/check/pkg01/ImpSafe04.stderr +++ b/testsuite/tests/safeHaskell/check/pkg01/ImpSafe04.stderr @@ -1,4 +1,4 @@ ImpSafe04.hs:9:1: error: Data.Word: Can't be safely imported! - The package (base-4.10.0.0) the module resides in isn't trusted. + The package (base-4.12.0.0) the module resides in isn't trusted. diff --git a/testsuite/tests/safeHaskell/check/pkg01/Makefile b/testsuite/tests/safeHaskell/check/pkg01/Makefile index 1c9d8eb596..ed5185d7e5 100644 --- a/testsuite/tests/safeHaskell/check/pkg01/Makefile +++ b/testsuite/tests/safeHaskell/check/pkg01/Makefile @@ -18,7 +18,7 @@ mkPackageDatabase.%: $(MAKE) -s --no-print-directory cleanPackageDatabase.$* mkdir pdb.$* - '$(TEST_HC)' -outputdir pdb.$* -o pdb.$*/setup Setup.hs -v0 + '$(TEST_HC)' $(TEST_HC_OPTS) -outputdir pdb.$* -o pdb.$*/setup Setup.hs -v0 '$(GHC_PKG)' init pdb.$*/local.db # We don't make use of -rtsopts in this test, and if it's enabled then @@ -44,28 +44,28 @@ safePkg01: $(safePkg01_GHC_PKG) field safePkg01-1.0 trusted echo echo 'M_SafePkg' - '$(TEST_HC)' $(SHOW_IFACE) pdb.safePkg01/dist/build/M_SafePkg.$(HI_SUF) | grep -E '^package dependencies:|^trusted:|^require own pkg trusted:' + '$(TEST_HC)' $(TEST_HC_OPTS) $(SHOW_IFACE) pdb.safePkg01/dist/build/M_SafePkg.$(HI_SUF) | grep -E '^package dependencies:|^trusted:|^require own pkg trusted:' echo echo 'M_SafePkg2' - '$(TEST_HC)' $(SHOW_IFACE) pdb.safePkg01/dist/build/M_SafePkg2.$(HI_SUF) | grep -E '^package dependencies:|^trusted:|^require own pkg trusted:' + '$(TEST_HC)' $(TEST_HC_OPTS) $(SHOW_IFACE) pdb.safePkg01/dist/build/M_SafePkg2.$(HI_SUF) | grep -E '^package dependencies:|^trusted:|^require own pkg trusted:' echo echo 'M_SafePkg3' - '$(TEST_HC)' $(SHOW_IFACE) pdb.safePkg01/dist/build/M_SafePkg3.$(HI_SUF) | grep -E '^package dependencies:|^trusted:|^require own pkg trusted:' + '$(TEST_HC)' $(TEST_HC_OPTS) $(SHOW_IFACE) pdb.safePkg01/dist/build/M_SafePkg3.$(HI_SUF) | grep -E '^package dependencies:|^trusted:|^require own pkg trusted:' echo echo 'M_SafePkg4' - '$(TEST_HC)' $(SHOW_IFACE) pdb.safePkg01/dist/build/M_SafePkg4.$(HI_SUF) | grep -E '^package dependencies:|^trusted:|^require own pkg trusted:' + '$(TEST_HC)' $(TEST_HC_OPTS) $(SHOW_IFACE) pdb.safePkg01/dist/build/M_SafePkg4.$(HI_SUF) | grep -E '^package dependencies:|^trusted:|^require own pkg trusted:' echo echo 'M_SafePkg5' - '$(TEST_HC)' $(SHOW_IFACE) pdb.safePkg01/dist/build/M_SafePkg5.$(HI_SUF) | grep -E '^package dependencies:|^trusted:|^require own pkg trusted:' + '$(TEST_HC)' $(TEST_HC_OPTS) $(SHOW_IFACE) pdb.safePkg01/dist/build/M_SafePkg5.$(HI_SUF) | grep -E '^package dependencies:|^trusted:|^require own pkg trusted:' echo echo 'M_SafePkg6' - '$(TEST_HC)' $(SHOW_IFACE) pdb.safePkg01/dist/build/M_SafePkg6.$(HI_SUF) | grep -E '^package dependencies:|^trusted:|^require own pkg trusted:' + '$(TEST_HC)' $(TEST_HC_OPTS) $(SHOW_IFACE) pdb.safePkg01/dist/build/M_SafePkg6.$(HI_SUF) | grep -E '^package dependencies:|^trusted:|^require own pkg trusted:' echo echo 'M_SafePkg7' - '$(TEST_HC)' $(SHOW_IFACE) pdb.safePkg01/dist/build/M_SafePkg7.$(HI_SUF) | grep -E '^package dependencies:|^trusted:|^require own pkg trusted:' + '$(TEST_HC)' $(TEST_HC_OPTS) $(SHOW_IFACE) pdb.safePkg01/dist/build/M_SafePkg7.$(HI_SUF) | grep -E '^package dependencies:|^trusted:|^require own pkg trusted:' echo echo 'M_SafePkg8' - '$(TEST_HC)' $(SHOW_IFACE) pdb.safePkg01/dist/build/M_SafePkg8.$(HI_SUF) | grep -E '^package dependencies:|^trusted:|^require own pkg trusted:' + '$(TEST_HC)' $(TEST_HC_OPTS) $(SHOW_IFACE) pdb.safePkg01/dist/build/M_SafePkg8.$(HI_SUF) | grep -E '^package dependencies:|^trusted:|^require own pkg trusted:' echo echo 'Testing setting trust' $(safePkg01_GHC_PKG) trust safePkg01-1.0 diff --git a/testsuite/tests/safeHaskell/check/pkg01/safePkg01.stdout b/testsuite/tests/safeHaskell/check/pkg01/safePkg01.stdout index 59886cd378..6967d97ad6 100644 --- a/testsuite/tests/safeHaskell/check/pkg01/safePkg01.stdout +++ b/testsuite/tests/safeHaskell/check/pkg01/safePkg01.stdout @@ -4,42 +4,42 @@ pdb.safePkg01/local.db trusted: False M_SafePkg -package dependencies: base-4.9.0.0* ghc-prim-0.5.0.0 integer-gmp-1.0.0.0 +package dependencies: base-4.12.0.0* ghc-prim-0.5.3 integer-gmp-1.0.2.0 trusted: safe require own pkg trusted: False M_SafePkg2 -package dependencies: base-4.9.0.0 ghc-prim-0.5.0.0 integer-gmp-1.0.0.0 +package dependencies: base-4.12.0.0 ghc-prim-0.5.3 integer-gmp-1.0.2.0 trusted: trustworthy require own pkg trusted: False M_SafePkg3 -package dependencies: base-4.9.0.0* ghc-prim-0.5.0.0 integer-gmp-1.0.0.0 +package dependencies: base-4.12.0.0* ghc-prim-0.5.3 integer-gmp-1.0.2.0 trusted: safe require own pkg trusted: True M_SafePkg4 -package dependencies: base-4.9.0.0* ghc-prim-0.5.0.0 integer-gmp-1.0.0.0 +package dependencies: base-4.12.0.0* ghc-prim-0.5.3 integer-gmp-1.0.2.0 trusted: safe require own pkg trusted: True M_SafePkg5 -package dependencies: base-4.9.0.0* ghc-prim-0.5.0.0 integer-gmp-1.0.0.0 +package dependencies: base-4.12.0.0* ghc-prim-0.5.3 integer-gmp-1.0.2.0 trusted: safe require own pkg trusted: True M_SafePkg6 -package dependencies: array-0.5.1.0 base-4.9.0.0* bytestring-0.10.7.0* deepseq-1.4.2.0 ghc-prim-0.5.0.0 integer-gmp-1.0.0.0 +package dependencies: array-0.5.2.0 base-4.12.0.0* bytestring-0.10.8.2* deepseq-1.4.4.0 ghc-prim-0.5.3 integer-gmp-1.0.2.0 trusted: trustworthy require own pkg trusted: False M_SafePkg7 -package dependencies: array-0.5.1.0 base-4.9.0.0* bytestring-0.10.7.0* deepseq-1.4.2.0 ghc-prim-0.5.0.0 integer-gmp-1.0.0.0 +package dependencies: array-0.5.2.0 base-4.12.0.0* bytestring-0.10.8.2* deepseq-1.4.4.0 ghc-prim-0.5.3 integer-gmp-1.0.2.0 trusted: safe require own pkg trusted: False M_SafePkg8 -package dependencies: array-0.5.1.0 base-4.9.0.0 bytestring-0.10.7.0* deepseq-1.4.2.0 ghc-prim-0.5.0.0 integer-gmp-1.0.0.0 +package dependencies: array-0.5.2.0 base-4.12.0.0 bytestring-0.10.8.2* deepseq-1.4.4.0 ghc-prim-0.5.3 integer-gmp-1.0.2.0 trusted: trustworthy require own pkg trusted: False diff --git a/testsuite/tests/safeHaskell/flags/SafeFlags17.stderr b/testsuite/tests/safeHaskell/flags/SafeFlags17.stderr index fa2c8a881b..27b68adf11 100644 --- a/testsuite/tests/safeHaskell/flags/SafeFlags17.stderr +++ b/testsuite/tests/safeHaskell/flags/SafeFlags17.stderr @@ -1,4 +1,4 @@ SafeFlags17.hs:4:8: error: Prelude: Can't be safely imported! - The package (base-4.10.0.0) the module resides in isn't trusted. + The package (base-4.12.0.0) the module resides in isn't trusted. diff --git a/testsuite/tests/safeHaskell/safeLanguage/SafeLang07.stderr b/testsuite/tests/safeHaskell/safeLanguage/SafeLang07.stderr index d32906e4e5..acfb8de460 100644 --- a/testsuite/tests/safeHaskell/safeLanguage/SafeLang07.stderr +++ b/testsuite/tests/safeHaskell/safeLanguage/SafeLang07.stderr @@ -4,4 +4,4 @@ SafeLang07.hs:2:14: warning: SafeLang07.hs:15:1: error: Could not find module ‘SafeLang07_A’ - Use -v to see a list of the files searched for. + Use -v (or `:set -v` in ghci) to see a list of the files searched for. diff --git a/testsuite/tests/safeHaskell/safeLanguage/SafeLang15.stderr b/testsuite/tests/safeHaskell/safeLanguage/SafeLang15.stderr index 5aed2c55ef..9434e29c30 100644 --- a/testsuite/tests/safeHaskell/safeLanguage/SafeLang15.stderr +++ b/testsuite/tests/safeHaskell/safeLanguage/SafeLang15.stderr @@ -1,2 +1,2 @@ -SafeLang15: SafeLang15.hs:22:9-37: Irrefutable pattern failed for pattern Just p' +SafeLang15: SafeLang15.hs:22:9-37: Non-exhaustive patterns in Just p' diff --git a/testsuite/tests/safeHaskell/safeLanguage/all.T b/testsuite/tests/safeHaskell/safeLanguage/all.T index a8a1bc0d7b..2807f738a8 100644 --- a/testsuite/tests/safeHaskell/safeLanguage/all.T +++ b/testsuite/tests/safeHaskell/safeLanguage/all.T @@ -36,6 +36,6 @@ test('SafeLang18', normal, compile, ['']) # Test building a package, that trust values are set correctly # and can be changed correctly #test('SafeRecomp01', -# clean_cmd('$MAKE -s --no-print-directory cleanSafeRecomp01'), +# normal, # run_command, ['$MAKE -s --no-print-directory safeRecomp01']) diff --git a/testsuite/tests/semigroup/SemigroupWarnings.hs b/testsuite/tests/semigroup/SemigroupWarnings.hs deleted file mode 100644 index 83ae2cf180..0000000000 --- a/testsuite/tests/semigroup/SemigroupWarnings.hs +++ /dev/null @@ -1,34 +0,0 @@ --- Test purpose: --- Ensure that missing semigroup warnings are issued --- correctly if the warning flag is enabled - -{-# OPTIONS_GHC -fwarn-semigroup #-} - -module SemigroupWarnings where - - - -import Data.Semigroup - - - --- Bad instance, should complain about missing Semigroup parent -data LacksSemigroup -instance Monoid LacksSemigroup where - mempty = undefined - mappend = undefined - - - --- Correct instance, should not warn -data HasSemigroup -instance Semigroup HasSemigroup where - (<>) = undefined -instance Monoid HasSemigroup where - mempty = undefined - mappend = undefined - - - --- Should issue a Prelude clash warning -(<>) = undefined diff --git a/testsuite/tests/semigroup/SemigroupWarnings.stderr b/testsuite/tests/semigroup/SemigroupWarnings.stderr deleted file mode 100644 index 277fea66ff..0000000000 --- a/testsuite/tests/semigroup/SemigroupWarnings.stderr +++ /dev/null @@ -1,8 +0,0 @@ - -SemigroupWarnings.hs:17:10: warning: [-Wsemigroup (in -Wcompat)] - ‘LacksSemigroup’ is an instance of Monoid but not Semigroup. - This will become an error in a future release. - -SemigroupWarnings.hs:34:1: warning: [-Wsemigroup (in -Wcompat)] - Local definition of ‘<>’ clashes with a future Prelude name. - This will become an error in a future release. diff --git a/testsuite/tests/semigroup/all.T b/testsuite/tests/semigroup/all.T deleted file mode 100644 index 0b1c3b9878..0000000000 --- a/testsuite/tests/semigroup/all.T +++ /dev/null @@ -1 +0,0 @@ -test('SemigroupWarnings', normal, compile, ['']) diff --git a/testsuite/tests/showIface/DocsInHiFile.hs b/testsuite/tests/showIface/DocsInHiFile.hs new file mode 100644 index 0000000000..26156722ac --- /dev/null +++ b/testsuite/tests/showIface/DocsInHiFile.hs @@ -0,0 +1,37 @@ +{-| `elem`, 'print', +`Unknown', +'<>', ':=:', 'Bool' +-} +module DocsInHiFile + ( DocsInHiFile.elem + , D(..) + , add + , P(..) + , Show(..) + ) where + +-- | '()', 'elem'. +elem :: () +elem = () + +-- | A datatype. +data D + = D0 -- ^ A constructor for 'D'. ' + | D1 -- ^ Another constructor + deriving ( Show -- ^ 'Show' instance + ) + +add :: Int -- ^ First summand for 'add' + -> Int -- ^ Second summand + -> Int -- ^ Sum +add a b = a + b + +-- | A class +class P f where + -- | A class method + p :: a -- ^ An argument + -> f a + +-- | Another datatype... +data D' +-- ^ ...with two docstrings. diff --git a/testsuite/tests/showIface/DocsInHiFile0.stdout b/testsuite/tests/showIface/DocsInHiFile0.stdout new file mode 100644 index 0000000000..e1c32d63c8 --- /dev/null +++ b/testsuite/tests/showIface/DocsInHiFile0.stdout @@ -0,0 +1,4 @@ +module header: + Nothing +declaration docs: +arg docs: diff --git a/testsuite/tests/showIface/DocsInHiFile1.stdout b/testsuite/tests/showIface/DocsInHiFile1.stdout new file mode 100644 index 0000000000..2576c2560c --- /dev/null +++ b/testsuite/tests/showIface/DocsInHiFile1.stdout @@ -0,0 +1,36 @@ +module header: + Just " `elem`, 'print', +`Unknown', +'<>', ':=:', 'Bool' +" +declaration docs: + elem: + " '()', 'elem'." + D: + " A datatype." + D0: + " A constructor for 'D'. '" + D1: + " Another constructor" + P: + " A class" + p: + " A class method" + $fShowD: + " 'Show' instance" + D': + " Another datatype... + + ...with two docstrings." +arg docs: + add: + 0: + " First summand for 'add'" + 1: + " Second summand" + 2: + " Sum" + p: + 0: + " An argument" + diff --git a/testsuite/tests/showIface/Makefile b/testsuite/tests/showIface/Makefile index 49b90342b3..7eafdfc9d2 100644 --- a/testsuite/tests/showIface/Makefile +++ b/testsuite/tests/showIface/Makefile @@ -5,3 +5,11 @@ include $(TOP)/mk/test.mk Orphans: '$(TEST_HC)' $(TEST_HC_OPTS) -c Orphans.hs '$(TEST_HC)' $(TEST_HC_OPTS) --show-iface Orphans.hi | grep -E '^(instance |family instance |"myrule)' | grep -v 'family instance modules:' + +DocsInHiFile0: + '$(TEST_HC)' $(TEST_HC_OPTS) -c DocsInHiFile.hs + '$(TEST_HC)' $(TEST_HC_OPTS) --show-iface DocsInHiFile.hi | grep -A 4 'module header:' + +DocsInHiFile1: + '$(TEST_HC)' $(TEST_HC_OPTS) -c -haddock DocsInHiFile.hs + '$(TEST_HC)' $(TEST_HC_OPTS) --show-iface DocsInHiFile.hi | grep -A 100 'module header:' diff --git a/testsuite/tests/showIface/Orphans.stdout b/testsuite/tests/showIface/Orphans.stdout index d61a5c98f3..63fcd79a19 100644 --- a/testsuite/tests/showIface/Orphans.stdout +++ b/testsuite/tests/showIface/Orphans.stdout @@ -1,6 +1,6 @@ -instance [orphan] IsList [Bool] = $fIsListBool -instance IsList [X] = $fIsListX -family instance Item [X] = D:R:ItemX -family instance [orphan] Item [Bool] = D:R:ItemBool -"myrule1" [orphan] forall @ a id @ (a -> a) (id @ a) = id @ a -"myrule2" forall id @ (X -> X) f = f +instance [orphan] GHC.Exts.IsList [GHC.Types.Bool] = $fIsListBool +instance GHC.Exts.IsList [X] = $fIsListX +family instance GHC.Exts.Item [X] = D:R:ItemX +family instance [orphan] GHC.Exts.Item [GHC.Types.Bool] +"myrule1" [orphan] forall @ a +"myrule2" forall GHC.Base.id @ (X -> X) f = f diff --git a/testsuite/tests/showIface/all.T b/testsuite/tests/showIface/all.T index 5c89b70b59..df5d5cd9ec 100644 --- a/testsuite/tests/showIface/all.T +++ b/testsuite/tests/showIface/all.T @@ -1 +1,9 @@ test('Orphans', normal, run_command, ['$MAKE -s --no-print-directory Orphans']) +test('DocsInHiFile0', + extra_files(['DocsInHiFile.hs']), + run_command, + ['$MAKE -s --no-print-directory DocsInHiFile0']) +test('DocsInHiFile1', + extra_files(['DocsInHiFile.hs']), + run_command, + ['$MAKE -s --no-print-directory DocsInHiFile1']) diff --git a/testsuite/tests/simplCore/should_compile/Makefile b/testsuite/tests/simplCore/should_compile/Makefile index f56a851597..277a5a664b 100644 --- a/testsuite/tests/simplCore/should_compile/Makefile +++ b/testsuite/tests/simplCore/should_compile/Makefile @@ -2,12 +2,21 @@ TOP=../../.. include $(TOP)/mk/boilerplate.mk include $(TOP)/mk/test.mk +T14978: + $(RM) -f T14978.o T14978.hi + -'$(TEST_HC)' $(TEST_HC_OPTS) -O -c -ddump-simpl T14978.hs -dsuppress-coercions | grep 'foo' + # Expecting the defn of 'foo' to apply Goof to an unboxed coercion + T13468: $(RM) -f T13468.o T13468.hi -'$(TEST_HC)' $(TEST_HC_OPTS) -O -c -ddump-simpl T13468.hs | grep 'Error' # Expecting no output from the grep, hence "-" # If the case branch is not eliminated, we get a patError +T3234: + $(RM) -f T3234.o T3234.hi + '$(TEST_HC)' $(TEST_HC_OPTS) -O -c -ddump-simpl-stats T3234.hs | grep 'fold/build' + T3990: $(RM) -f T3990.o T3990.hi '$(TEST_HC)' $(TEST_HC_OPTS) -O -c -ddump-simpl T3990.hs | grep 'test_case' @@ -183,7 +192,7 @@ T5996: '$(TEST_HC)' $(TEST_HC_OPTS) -O -c T5996.hs -ddump-simpl -dsuppress-uniques -dsuppress-all | grep y2 T10083: - $(RM) -f T10083.o T10083.hi T10083.hi-boot T10083a.o T10083a.hi + $(RM) -f T10083.o T10083.hi T10083.hi-boot T10083a.o T10083a.hi '$(TEST_HC)' $(TEST_HC_OPTS) -c -O T10083.hs-boot '$(TEST_HC)' $(TEST_HC_OPTS) -c -O T10083a.hs '$(TEST_HC)' $(TEST_HC_OPTS) -c -O T10083.hs @@ -205,8 +214,8 @@ T12877: T13025: $(RM) -f T13025.o T13025.hi T13025a.o T13025a.hi '$(TEST_HC)' $(TEST_HC_OPTS) -c -O T13025a.hs - -'$(TEST_HC)' $(TEST_HC_OPTS) -c -O T13025.hs -ddump-simpl | grep -c HEq_sc - # No lines should match 'HEq_sc' so wc should output zeros + -'$(TEST_HC)' $(TEST_HC_OPTS) -c -O T13025.hs -ddump-simpl | grep -c heq_sel + # No lines should match 'heq_sel' so wc should output zeros .PHONY: str-rules str-rules: @@ -230,3 +239,15 @@ T11272: .PHONY: T12600 T12600: '$(TEST_HC)' $(TEST_HC_OPTS) -c -O -ddump-prep -dsuppress-all -dsuppress-uniques -dno-suppress-type-signatures -dppr-cols=200 T12600.hs | grep "wfoo" | head -n 1 + +# We don't expect to case match on any literal numbers other than +# 0 or 1. See T14140.hs for an explanation. +T14140: + $(RM) -f T14140.o T14140.hi + -'$(TEST_HC)' $(TEST_HC_OPTS) -O -c -ddump-simpl T14140.hs | grep '[2-9]# *->' +# Expecting no output from the grep, hence "-" + +T15631: + $(RM) -f T15631.o T15631.hi + '$(TEST_HC)' $(TEST_HC_OPTS) -O -c -ddump-simpl -dsuppress-uniques T15631.hs | grep 'case' +# Expecting one fewwer case expressions after fixing Trac #15631 diff --git a/testsuite/tests/simplCore/should_compile/T13025a.hs b/testsuite/tests/simplCore/should_compile/T13025a.hs index 3f9a4cbe21..cdfb899c1a 100644 --- a/testsuite/tests/simplCore/should_compile/T13025a.hs +++ b/testsuite/tests/simplCore/should_compile/T13025a.hs @@ -4,17 +4,19 @@ TypeOperators #-} module T13025a where +import Data.Kind (Type) + data Nat = Z | S Nat data Proxy a = Proxy -data Field :: (k,*) -> * where +data Field :: (k,Type) -> Type where Field :: a -> Field '(s,a) type family Index r rs :: Nat where Index r (r ': rs) = 'Z Index r (s ': rs) = 'S (Index r rs) -data Rec (rs :: [ (k,*) ]) where +data Rec (rs :: [ (k,Type) ]) where Nil :: Rec '[] (:&) :: Field r -> Rec rs -> Rec (r ': rs) infixr 5 :& diff --git a/testsuite/tests/simplCore/should_compile/T13143.stderr b/testsuite/tests/simplCore/should_compile/T13143.stderr index c9cdd95bc2..d8b0c1b468 100644 --- a/testsuite/tests/simplCore/should_compile/T13143.stderr +++ b/testsuite/tests/simplCore/should_compile/T13143.stderr @@ -7,12 +7,12 @@ Rec { -- RHS size: {terms: 4, types: 4, coercions: 0, joins: 0/0} T13143.$wf [InlPrag=NOINLINE, Occ=LoopBreaker] :: forall a. GHC.Prim.Void# -> a -[GblId, Arity=1, Caf=NoCafRefs, Str=<B,A>b] +[GblId, Arity=1, Caf=NoCafRefs, Str=<B,A>b, Unf=OtherCon []] T13143.$wf = \ (@ a) _ [Occ=Dead] -> T13143.$wf @ a GHC.Prim.void# end Rec } -- RHS size: {terms: 4, types: 4, coercions: 0, joins: 0/0} -f [InlPrag=INLINE[0]] :: forall a. Int -> a +f [InlPrag=NOUSERINLINE[0]] :: forall a. Int -> a [GblId, Arity=1, Caf=NoCafRefs, @@ -74,9 +74,9 @@ lvl = T13143.$wf @ Int GHC.Prim.void# Rec { -- RHS size: {terms: 28, types: 7, coercions: 0, joins: 0/0} -T13143.$wg [InlPrag=[0], Occ=LoopBreaker] +T13143.$wg [InlPrag=NOUSERINLINE[2], Occ=LoopBreaker] :: Bool -> Bool -> GHC.Prim.Int# -> GHC.Prim.Int# -[GblId, Arity=3, Str=<S,1*U><S,1*U><S,U>] +[GblId, Arity=3, Str=<S,1*U><S,1*U><S,U>, Unf=OtherCon []] T13143.$wg = \ (w :: Bool) (w1 :: Bool) (ww :: GHC.Prim.Int#) -> case w of { @@ -94,7 +94,7 @@ T13143.$wg end Rec } -- RHS size: {terms: 14, types: 6, coercions: 0, joins: 0/0} -g [InlPrag=INLINE[0]] :: Bool -> Bool -> Int -> Int +g [InlPrag=NOUSERINLINE[2]] :: Bool -> Bool -> Int -> Int [GblId, Arity=3, Str=<S,1*U><S,1*U><S(S),1*U(U)>m, @@ -105,7 +105,9 @@ g [InlPrag=INLINE[0]] :: Bool -> Bool -> Int -> Int (w1 [Occ=Once] :: Bool) (w2 [Occ=Once!] :: Int) -> case w2 of { GHC.Types.I# ww1 [Occ=Once] -> - case T13143.$wg w w1 ww1 of ww2 { __DEFAULT -> GHC.Types.I# ww2 } + case T13143.$wg w w1 ww1 of ww2 [Occ=Once] { __DEFAULT -> + GHC.Types.I# ww2 + } }}] g = \ (w :: Bool) (w1 :: Bool) (w2 :: Int) -> case w2 of { GHC.Types.I# ww1 -> diff --git a/testsuite/tests/simplCore/should_compile/T13543.stderr b/testsuite/tests/simplCore/should_compile/T13543.stderr index 0519ecba6e..69f6808bc4 100644 --- a/testsuite/tests/simplCore/should_compile/T13543.stderr +++ b/testsuite/tests/simplCore/should_compile/T13543.stderr @@ -1 +1,11 @@ -
\ No newline at end of file +==================== Strictness signatures ==================== +Foo.$trModule: m +Foo.f: <S(S),1*U(1*U)><S(S),1*U(U)><S(S),1*U(U)>m +Foo.g: <S(S(S)S(S)),1*U(1*U(U),1*U(U))>m + + + +==================== Strictness signatures ==================== +Foo.$trModule: m +Foo.f: <S(S),1*U(1*U)><S(S),1*U(U)><S(S),1*U(U)>m +Foo.g: <S(S(S)S(S)),1*U(1*U(U),1*U(U))>m
\ No newline at end of file diff --git a/testsuite/tests/simplCore/should_compile/T13658.hs b/testsuite/tests/simplCore/should_compile/T13658.hs index 0890e89b7f..662fa66022 100644 --- a/testsuite/tests/simplCore/should_compile/T13658.hs +++ b/testsuite/tests/simplCore/should_compile/T13658.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE TypeInType #-} +{-# LANGUAGE PolyKinds #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE RankNTypes #-} diff --git a/testsuite/tests/simplCore/should_compile/T13990.hs b/testsuite/tests/simplCore/should_compile/T13990.hs new file mode 100644 index 0000000000..cbf3949af7 --- /dev/null +++ b/testsuite/tests/simplCore/should_compile/T13990.hs @@ -0,0 +1,14 @@ +{-# LANGUAGE EmptyCase, GADTs #-} + +module T13990 where + +data T a where + TInt :: T Int + +absurd :: T Bool -> a +absurd v = case v of {} + +data Foo = Foo !(T Bool) + +absurdFoo :: Foo -> a +absurdFoo (Foo x) = absurd x diff --git a/testsuite/tests/simplCore/should_compile/T13990.stderr b/testsuite/tests/simplCore/should_compile/T13990.stderr new file mode 100644 index 0000000000..f30ebece6e --- /dev/null +++ b/testsuite/tests/simplCore/should_compile/T13990.stderr @@ -0,0 +1,4 @@ + +T13990.hs:14:1: warning: [-Woverlapping-patterns (in -Wdefault)] + Pattern match has inaccessible right hand side + In an equation for ‘absurdFoo’: absurdFoo (Foo x) = ... diff --git a/testsuite/tests/simplCore/should_compile/T14137.hs b/testsuite/tests/simplCore/should_compile/T14137.hs new file mode 100644 index 0000000000..f8cbbc251a --- /dev/null +++ b/testsuite/tests/simplCore/should_compile/T14137.hs @@ -0,0 +1,15 @@ +module T14137 where + +-- The point of this test is that we should inline 'thunk' +-- into j's RHS, and we can do so quite aggressively, even +-- when we aren't optimising. See the ticket. +-- +-- It's not a big deal, because in the end FloatIn +-- does the same job, only later + +f xs = let thunk = length xs + j = Just thunk + g 0 = j + g n = g (n-1) + in + g 7 diff --git a/testsuite/tests/simplCore/should_compile/T14137.stderr b/testsuite/tests/simplCore/should_compile/T14137.stderr new file mode 100644 index 0000000000..602a74072d --- /dev/null +++ b/testsuite/tests/simplCore/should_compile/T14137.stderr @@ -0,0 +1,63 @@ + +==================== Tidy Core ==================== +Result size of Tidy Core + = {terms: 45, types: 41, coercions: 0, joins: 2/2} + +-- RHS size: {terms: 30, types: 24, coercions: 0, joins: 2/2} +f :: forall (t :: * -> *) a. Foldable t => t a -> Maybe Int +[GblId, Arity=2] +f = \ (@ (t :: * -> *)) + (@ a) + ($dFoldable :: Foldable t) + (xs :: t a) -> + join { + j :: Maybe Int + [LclId[JoinId(0)], Unf=OtherCon []] + j = GHC.Base.Just @ Int (length @ t $dFoldable @ a xs) } in + joinrec { + g [Occ=LoopBreaker] :: Integer -> Maybe Int + [LclId[JoinId(1)], Arity=1, Unf=OtherCon []] + g (ds :: Integer) + = case == + @ Integer + integer-gmp-1.0.1.0:GHC.Integer.Type.$fEqInteger + ds + (fromInteger @ Integer GHC.Num.$fNumInteger 0) + of { + False -> + jump g + (- @ Integer + GHC.Num.$fNumInteger + ds + (fromInteger @ Integer GHC.Num.$fNumInteger 1)); + True -> jump j + }; } in + jump g 7 + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +$trModule1 :: GHC.Prim.Addr# +[GblId, Caf=NoCafRefs] +$trModule1 = "main"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +$trModule2 :: GHC.Types.TrName +[GblId, Caf=NoCafRefs] +$trModule2 = GHC.Types.TrNameS $trModule1 + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +$trModule3 :: GHC.Prim.Addr# +[GblId, Caf=NoCafRefs] +$trModule3 = "T14137"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +$trModule4 :: GHC.Types.TrName +[GblId, Caf=NoCafRefs] +$trModule4 = GHC.Types.TrNameS $trModule3 + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +T14137.$trModule :: GHC.Types.Module +[GblId, Caf=NoCafRefs] +T14137.$trModule = GHC.Types.Module $trModule2 $trModule4 + + + diff --git a/testsuite/tests/simplCore/should_compile/T14140.hs b/testsuite/tests/simplCore/should_compile/T14140.hs new file mode 100644 index 0000000000..39476a2d64 --- /dev/null +++ b/testsuite/tests/simplCore/should_compile/T14140.hs @@ -0,0 +1,29 @@ +-- We don't want to see a case match on the result +-- of dataToTag#. We check that by looking for case +-- matches on any literal other than 0# or 1#. We +-- only really expect to see 1# here (and not the tag +-- for OtherOS), but just in case GHC decides to get +-- clever with its knowledge of the possible results +-- of (==#), we also permit 0#. +{-# LANGUAGE MagicHash, BangPatterns #-} +module T14140 where +import GHC.Exts + +data OS = Linux | Windows | OSX -- tier 1 desktop OSs + | FreeBSD | OpenBSD | NetBSD -- other free Unix OSs + | DragonFly + | Solaris | AIX | HPUX | IRIX -- ageing Unix OSs + | HaLVM -- bare metal / VMs / hypervisors + | Hurd -- GNU's microkernel + | IOS | Android -- mobile OSs + | Ghcjs + | OtherOS String + +-- This is similar to the derived Eq instance. We write it +-- out manually to prevent future deriving changes from +-- changing the test. +instance Eq OS where + OtherOS x == OtherOS y = x == y + (!x) == (!y) = case dataToTag# x ==# dataToTag# y of + 1# -> True + _ -> False diff --git a/testsuite/tests/simplCore/should_compile/T14152.hs b/testsuite/tests/simplCore/should_compile/T14152.hs new file mode 100644 index 0000000000..fd922595ae --- /dev/null +++ b/testsuite/tests/simplCore/should_compile/T14152.hs @@ -0,0 +1,23 @@ +module T14152 where + +{- +This test case tests exitification. With exitification, the "case thunk" should +be lifted out of "innerGo", then "thunk" gets inlined, we have case-of-case and +case-of-known-constructor and the string "dead code" should disappear + +The test case T14152b uses the same file, but with -fno-exitification, and checks +that the strings "dead code" is still present. If not, then some other optimization +does the job now (great!), but then we need to come up with a better test case +for exitification (or get rid of it). +-} + +go 0 y = y +go n y = innerGo n y + where + innerGo 10 y = 0 -- we want to be lazy in thunk + innerGo 0 y = case thunk of + Nothing -> error "dead code" + Just y' -> go (n-1) (y + y') + innerGo n y = innerGo (n-1) (y*y) + + thunk = if y==0 then Just (y + y) else Just y diff --git a/testsuite/tests/simplCore/should_compile/T14152.stderr b/testsuite/tests/simplCore/should_compile/T14152.stderr new file mode 100644 index 0000000000..c782d84fc3 --- /dev/null +++ b/testsuite/tests/simplCore/should_compile/T14152.stderr @@ -0,0 +1,129 @@ + +==================== Tidy Core ==================== +Result size of Tidy Core + = {terms: 103, types: 65, coercions: 0, joins: 2/5} + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +T14152.go2 :: Integer +[GblId, + Caf=NoCafRefs, + Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 100 0}] +T14152.go2 = 0 + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +T14152.go1 :: Integer +[GblId, + Caf=NoCafRefs, + Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 100 0}] +T14152.go1 = 1 + +-- RHS size: {terms: 84, types: 43, coercions: 0, joins: 2/5} +go :: forall t a. (Num a, Num t, Eq a, Eq t) => t -> a -> a +[GblId, + Arity=6, + Caf=NoCafRefs, + Str=<L,U(C(C1(U)),A,C(C1(U)),A,A,A,1*C1(U))><L,U(A,C(C1(U)),A,A,A,A,C(U))><L,U(C(C1(U)),A)><S(C(C(S))L),U(C(C1(U)),A)><L,U><L,U>, + Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, + Guidance=IF_ARGS [150 150 30 60 0 0] 610 0}] +go + = \ (@ t_a2l3) + (@ a_a2i4) + ($dNum_a2l7 :: Num a_a2i4) + ($dNum1_a2l8 :: Num t_a2l3) + ($dEq_a2l9 :: Eq a_a2i4) + ($dEq1_a2la :: Eq t_a2l3) + (eta_B2 :: t_a2l3) + (eta1_B1 :: a_a2i4) -> + let { + lvl_s2o6 :: a_a2i4 + [LclId] + lvl_s2o6 = fromInteger @ a_a2i4 $dNum_a2l7 T14152.go2 } in + let { + lvl1_s2oH :: t_a2l3 + [LclId] + lvl1_s2oH = fromInteger @ t_a2l3 $dNum1_a2l8 T14152.go1 } in + let { + lvl2_s2o4 :: t_a2l3 + [LclId] + lvl2_s2o4 = fromInteger @ t_a2l3 $dNum1_a2l8 T14152.go2 } in + joinrec { + go3_s2nB [Occ=LoopBreaker] :: t_a2l3 -> a_a2i4 -> a_a2i4 + [LclId[JoinId(2)], Arity=2, Str=<L,U><L,U>, Unf=OtherCon []] + go3_s2nB (ds_d2md :: t_a2l3) (y_atn :: a_a2i4) + = case == @ t_a2l3 $dEq1_a2la ds_d2md lvl2_s2o4 of { + False -> + joinrec { + innerGo_s2nP [Occ=LoopBreaker] :: t_a2l3 -> a_a2i4 -> a_a2i4 + [LclId[JoinId(2)], Arity=2, Str=<L,U><L,U>, Unf=OtherCon []] + innerGo_s2nP (ds1_d2mf :: t_a2l3) (y1_ats :: a_a2i4) + = case == @ t_a2l3 $dEq1_a2la ds1_d2mf lvl2_s2o4 of { + False -> + jump innerGo_s2nP + (- @ t_a2l3 $dNum1_a2l8 ds1_d2mf lvl1_s2oH) + (* @ a_a2i4 $dNum_a2l7 y1_ats y1_ats); + True -> + case == @ a_a2i4 $dEq_a2l9 y_atn lvl_s2o6 of { + False -> + jump go3_s2nB + (- @ t_a2l3 $dNum1_a2l8 ds_d2md lvl1_s2oH) + (+ @ a_a2i4 $dNum_a2l7 y1_ats y_atn); + True -> + jump go3_s2nB + (- @ t_a2l3 $dNum1_a2l8 ds_d2md lvl1_s2oH) + (+ @ a_a2i4 $dNum_a2l7 y1_ats (+ @ a_a2i4 $dNum_a2l7 y_atn y_atn)) + } + }; } in + jump innerGo_s2nP ds_d2md y_atn; + True -> y_atn + }; } in + jump go3_s2nB eta_B2 eta1_B1 + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +T14152.$trModule4 :: GHC.Prim.Addr# +[GblId, + Caf=NoCafRefs, + Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}] +T14152.$trModule4 = "main"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +T14152.$trModule3 :: GHC.Types.TrName +[GblId, + Caf=NoCafRefs, + Str=m1, + Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 20}] +T14152.$trModule3 = GHC.Types.TrNameS T14152.$trModule4 + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +T14152.$trModule2 :: GHC.Prim.Addr# +[GblId, + Caf=NoCafRefs, + Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 0}] +T14152.$trModule2 = "T14152"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +T14152.$trModule1 :: GHC.Types.TrName +[GblId, + Caf=NoCafRefs, + Str=m1, + Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 20}] +T14152.$trModule1 = GHC.Types.TrNameS T14152.$trModule2 + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +T14152.$trModule :: GHC.Types.Module +[GblId, + Caf=NoCafRefs, + Str=m, + Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 30}] +T14152.$trModule + = GHC.Types.Module T14152.$trModule3 T14152.$trModule1 + + + diff --git a/testsuite/tests/simplCore/should_compile/T14152a.stderr b/testsuite/tests/simplCore/should_compile/T14152a.stderr new file mode 100644 index 0000000000..d4b2ed39b8 --- /dev/null +++ b/testsuite/tests/simplCore/should_compile/T14152a.stderr @@ -0,0 +1,222 @@ + +==================== Tidy Core ==================== +Result size of Tidy Core + = {terms: 156, types: 98, coercions: 4, joins: 3/7} + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +T14152.go3 :: Integer +[GblId, + Caf=NoCafRefs, + Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 100 0}] +T14152.go3 = 0 + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +T14152.go2 :: Integer +[GblId, + Caf=NoCafRefs, + Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 100 0}] +T14152.go2 = 1 + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +lvl_r2qm :: GHC.Prim.Addr# +[GblId, Caf=NoCafRefs] +lvl_r2qm = "error"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl1_r2qn :: [Char] +[GblId] +lvl1_r2qn = GHC.CString.unpackCString# lvl_r2qm + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +T14152.$trModule4 :: GHC.Prim.Addr# +[GblId, + Caf=NoCafRefs, + Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}] +T14152.$trModule4 = "main"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl2_r2qo :: [Char] +[GblId] +lvl2_r2qo = GHC.CString.unpackCString# T14152.$trModule4 + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +T14152.$trModule2 :: GHC.Prim.Addr# +[GblId, + Caf=NoCafRefs, + Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 0}] +T14152.$trModule2 = "T14152"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl3_r2qp :: [Char] +[GblId] +lvl3_r2qp = GHC.CString.unpackCString# T14152.$trModule2 + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +lvl4_r2qq :: GHC.Prim.Addr# +[GblId, Caf=NoCafRefs] +lvl4_r2qq = "T14152a.hs"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl5_r2qr :: [Char] +[GblId] +lvl5_r2qr = GHC.CString.unpackCString# lvl4_r2qq + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl6_r2qs :: Int +[GblId, Caf=NoCafRefs, Str=m] +lvl6_r2qs = GHC.Types.I# 18# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl7_r2qt :: Int +[GblId, Caf=NoCafRefs, Str=m] +lvl7_r2qt = GHC.Types.I# 20# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +lvl8_r2qu :: Int +[GblId, Caf=NoCafRefs, Str=m] +lvl8_r2qu = GHC.Types.I# 37# + +-- RHS size: {terms: 8, types: 0, coercions: 0, joins: 0/0} +lvl9_r2qv :: GHC.Stack.Types.SrcLoc +[GblId, Str=m] +lvl9_r2qv + = GHC.Stack.Types.SrcLoc + lvl2_r2qo + lvl3_r2qp + lvl5_r2qr + lvl6_r2qs + lvl7_r2qt + lvl6_r2qs + lvl8_r2qu + +-- RHS size: {terms: 4, types: 0, coercions: 0, joins: 0/0} +lvl10_r2qw :: GHC.Stack.Types.CallStack +[GblId, Str=m2] +lvl10_r2qw + = GHC.Stack.Types.PushCallStack + lvl1_r2qn lvl9_r2qv GHC.Stack.Types.EmptyCallStack + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +lvl11_r2qx :: GHC.Prim.Addr# +[GblId, Caf=NoCafRefs] +lvl11_r2qx = "dead code"# + +-- RHS size: {terms: 5, types: 4, coercions: 4, joins: 0/0} +T14152.go1 :: forall a. a +[GblId, Str=x] +T14152.go1 + = \ (@ a_a2i4) -> + error + @ 'GHC.Types.LiftedRep + @ a_a2i4 + (lvl10_r2qw + `cast` (Sym (GHC.Classes.N:IP[0] + <"callStack">_N <GHC.Stack.Types.CallStack>_N) + :: (GHC.Stack.Types.CallStack :: *) + ~R# (?callStack::GHC.Stack.Types.CallStack :: Constraint))) + (GHC.CString.unpackCString# lvl11_r2qx) + +-- RHS size: {terms: 90, types: 53, coercions: 0, joins: 3/7} +go :: forall t a. (Num a, Num t, Eq a, Eq t) => t -> a -> a +[GblId, + Arity=6, + Str=<L,U(C(C1(U)),A,C(C1(U)),A,A,A,1*C1(U))><L,U(A,C(C1(U)),A,A,A,A,C(U))><L,U(C(C1(U)),A)><S(C(C(S))L),U(C(C1(U)),A)><L,U><L,U>, + Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, + Guidance=IF_ARGS [120 120 30 60 0 0] 582 0}] +go + = \ (@ t_a2l3) + (@ a_a2i4) + ($dNum_a2l7 :: Num a_a2i4) + ($dNum1_a2l8 :: Num t_a2l3) + ($dEq_a2l9 :: Eq a_a2i4) + ($dEq1_a2la :: Eq t_a2l3) + (eta_B2 :: t_a2l3) + (eta1_B1 :: a_a2i4) -> + let { + lvl12_s2o4 :: a_a2i4 + [LclId] + lvl12_s2o4 = fromInteger @ a_a2i4 $dNum_a2l7 T14152.go3 } in + let { + lvl13_s2oF :: t_a2l3 + [LclId] + lvl13_s2oF = fromInteger @ t_a2l3 $dNum1_a2l8 T14152.go2 } in + let { + lvl14_s2o2 :: t_a2l3 + [LclId] + lvl14_s2o2 = fromInteger @ t_a2l3 $dNum1_a2l8 T14152.go3 } in + joinrec { + go4_s2nB [Occ=LoopBreaker] :: t_a2l3 -> a_a2i4 -> a_a2i4 + [LclId[JoinId(2)], Arity=2, Str=<L,U><L,U>, Unf=OtherCon []] + go4_s2nB (ds_d2md :: t_a2l3) (y_atn :: a_a2i4) + = case == @ t_a2l3 $dEq1_a2la ds_d2md lvl14_s2o2 of { + False -> + join { + $j_s2py [Dmd=<C(S),1*C1(U)>] :: Maybe a_a2i4 -> a_a2i4 + [LclId[JoinId(1)], Arity=1, Str=<S,U>, Unf=OtherCon []] + $j_s2py (thunk_s2nZ [OS=OneShot] :: Maybe a_a2i4) + = let { + lvl15_s2oG :: t_a2l3 + [LclId] + lvl15_s2oG = - @ t_a2l3 $dNum1_a2l8 ds_d2md lvl13_s2oF } in + joinrec { + innerGo_s2nO [Occ=LoopBreaker] :: t_a2l3 -> a_a2i4 -> a_a2i4 + [LclId[JoinId(2)], Arity=2, Str=<L,U><L,U>, Unf=OtherCon []] + innerGo_s2nO (ds1_d2mf :: t_a2l3) (y1_ats :: a_a2i4) + = case == @ t_a2l3 $dEq1_a2la ds1_d2mf lvl14_s2o2 of { + False -> + jump innerGo_s2nO + (- @ t_a2l3 $dNum1_a2l8 ds1_d2mf lvl13_s2oF) + (* @ a_a2i4 $dNum_a2l7 y1_ats y1_ats); + True -> + case thunk_s2nZ of { + Nothing -> T14152.go1 @ a_a2i4; + Just y'_atI -> + jump go4_s2nB lvl15_s2oG (+ @ a_a2i4 $dNum_a2l7 y1_ats y'_atI) + } + }; } in + jump innerGo_s2nO ds_d2md y_atn } in + case == @ a_a2i4 $dEq_a2l9 y_atn lvl12_s2o4 of { + False -> jump $j_s2py (GHC.Base.Just @ a_a2i4 y_atn); + True -> + jump $j_s2py + (GHC.Base.Just @ a_a2i4 (+ @ a_a2i4 $dNum_a2l7 y_atn y_atn)) + }; + True -> y_atn + }; } in + jump go4_s2nB eta_B2 eta1_B1 + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +T14152.$trModule3 :: GHC.Types.TrName +[GblId, + Caf=NoCafRefs, + Str=m1, + Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 20}] +T14152.$trModule3 = GHC.Types.TrNameS T14152.$trModule4 + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +T14152.$trModule1 :: GHC.Types.TrName +[GblId, + Caf=NoCafRefs, + Str=m1, + Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 20}] +T14152.$trModule1 = GHC.Types.TrNameS T14152.$trModule2 + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +T14152.$trModule :: GHC.Types.Module +[GblId, + Caf=NoCafRefs, + Str=m, + Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 30}] +T14152.$trModule + = GHC.Types.Module T14152.$trModule3 T14152.$trModule1 + + + diff --git a/testsuite/tests/simplCore/should_compile/T14186.hs b/testsuite/tests/simplCore/should_compile/T14186.hs new file mode 100644 index 0000000000..1fe1d6acf5 --- /dev/null +++ b/testsuite/tests/simplCore/should_compile/T14186.hs @@ -0,0 +1,4 @@ +module T14186 where + +foo f g (x, xs) = (f (g x), map (f . g) xs) +bar f g (x, xs) = (f (g x), map (f . g) xs) diff --git a/testsuite/tests/simplCore/should_compile/T14186.stderr b/testsuite/tests/simplCore/should_compile/T14186.stderr new file mode 100644 index 0000000000..17ccc2c07d --- /dev/null +++ b/testsuite/tests/simplCore/should_compile/T14186.stderr @@ -0,0 +1,119 @@ + +==================== Tidy Core ==================== +Result size of Tidy Core + = {terms: 36, types: 68, coercions: 0, joins: 0/0} + +-- RHS size: {terms: 19, types: 27, coercions: 0, joins: 0/0} +foo [InlPrag=[0]] + :: forall t1 b t2. + (t1 -> b) -> (t2 -> t1) -> (t2, [t2]) -> (b, [b]) +[GblId, + Arity=3, + Caf=NoCafRefs, + Str=<L,C(U)><L,C(U)><S,1*U(U,1*U)>m, + Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, + Guidance=ALWAYS_IF(arity=3,unsat_ok=True,boring_ok=False) + Tmpl= \ (@ t_sZi) + (@ b_sZj) + (@ t1_sZk) + (w_sZl :: t_sZi -> b_sZj) + (w1_sZm :: t1_sZk -> t_sZi) + (w2_sZn [Occ=Once!] :: (t1_sZk, [t1_sZk])) -> + case w2_sZn of { (ww1_sZq [Occ=Once], ww2_sZr [Occ=Once]) -> + (w_sZl (w1_sZm ww1_sZq), + map + @ t1_sZk + @ b_sZj + (\ (x_aXa [Occ=Once] :: t1_sZk) -> w_sZl (w1_sZm x_aXa)) + ww2_sZr) + }}] +foo + = \ (@ t_sZi) + (@ b_sZj) + (@ t1_sZk) + (w_sZl :: t_sZi -> b_sZj) + (w1_sZm :: t1_sZk -> t_sZi) + (w2_sZn :: (t1_sZk, [t1_sZk])) -> + case w2_sZn of { (ww1_sZq, ww2_sZr) -> + (w_sZl (w1_sZm ww1_sZq), + map + @ t1_sZk + @ b_sZj + (\ (x_aXa :: t1_sZk) -> w_sZl (w1_sZm x_aXa)) + ww2_sZr) + } + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +bar [InlPrag=[0]] + :: forall t1 b t2. + (t1 -> b) -> (t2 -> t1) -> (t2, [t2]) -> (b, [b]) +[GblId, + Arity=3, + Caf=NoCafRefs, + Str=<L,C(U)><L,C(U)><S,1*U(U,1*U)>m, + Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, + Guidance=ALWAYS_IF(arity=3,unsat_ok=True,boring_ok=False) + Tmpl= \ (@ t_sZx) + (@ b_sZy) + (@ t1_sZz) + (w_sZA :: t_sZx -> b_sZy) + (w1_sZB :: t1_sZz -> t_sZx) + (w2_sZC [Occ=Once!] :: (t1_sZz, [t1_sZz])) -> + case w2_sZC of { (ww1_sZF [Occ=Once], ww2_sZG [Occ=Once]) -> + (w_sZA (w1_sZB ww1_sZF), + map + @ t1_sZz + @ b_sZy + (\ (x_aXa [Occ=Once] :: t1_sZz) -> w_sZA (w1_sZB x_aXa)) + ww2_sZG) + }}] +bar = foo + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +T14186.$trModule4 :: GHC.Prim.Addr# +[GblId, + Caf=NoCafRefs, + Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}] +T14186.$trModule4 = "main"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +T14186.$trModule3 :: GHC.Types.TrName +[GblId, + Caf=NoCafRefs, + Str=m1, + Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 20}] +T14186.$trModule3 = GHC.Types.TrNameS T14186.$trModule4 + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +T14186.$trModule2 :: GHC.Prim.Addr# +[GblId, + Caf=NoCafRefs, + Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 0}] +T14186.$trModule2 = "T14186"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +T14186.$trModule1 :: GHC.Types.TrName +[GblId, + Caf=NoCafRefs, + Str=m1, + Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 20}] +T14186.$trModule1 = GHC.Types.TrNameS T14186.$trModule2 + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +T14186.$trModule :: GHC.Types.Module +[GblId, + Caf=NoCafRefs, + Str=m, + Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, + WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 30}] +T14186.$trModule + = GHC.Types.Module T14186.$trModule3 T14186.$trModule1 + + + diff --git a/testsuite/tests/simplCore/should_compile/T14270a.hs b/testsuite/tests/simplCore/should_compile/T14270a.hs new file mode 100644 index 0000000000..5054b43a2c --- /dev/null +++ b/testsuite/tests/simplCore/should_compile/T14270a.hs @@ -0,0 +1,28 @@ +{-# LANGUAGE TypeApplications, ScopedTypeVariables, GADTs, RankNTypes, + PolyKinds, KindSignatures #-} +{-# OPTIONS_GHC -O2 #-} -- We are provoking a bug in SpecConstr + +module T14270a where + +import Data.Kind +import Data.Proxy + +data T a = T1 (T a) | T2 + +data K (a :: k) where + K1 :: K (a :: Type) + K2 :: K a + +f :: T (a :: Type) -> Bool +f (T1 x) = f x +f T2 = True + +g :: forall (a :: k). K a -> T a -> Bool +g kv x = case kv of + K1 -> f @a T2 -- f @a (T1 x) gives a different crash + k2 -> True + +-- The point here is that the call to f looks like +-- f @(a |> co) (T2 @(a |> co)) +-- where 'co' is bound by the pattern match on K1 +-- See Note [SpecConstr and casts] in SpecConstr diff --git a/testsuite/tests/simplCore/should_compile/T14272.hs b/testsuite/tests/simplCore/should_compile/T14272.hs new file mode 100644 index 0000000000..d520c068f5 --- /dev/null +++ b/testsuite/tests/simplCore/should_compile/T14272.hs @@ -0,0 +1,7 @@ +import Data.Bits (bit) + +main :: IO () +main = putStrLn (show (f undefined)) + +f :: [Int] -> Int +f = sum . zipWith ((+) . bit) [0..] . map undefined . scanl undefined undefined diff --git a/testsuite/tests/simplCore/should_compile/T14650.hs b/testsuite/tests/simplCore/should_compile/T14650.hs new file mode 100644 index 0000000000..b9eac20021 --- /dev/null +++ b/testsuite/tests/simplCore/should_compile/T14650.hs @@ -0,0 +1,76 @@ +module MergeSort (
+ msortBy
+ ) where
+
+infixl 7 :%
+infixr 6 :&
+
+data LenList a = LL {-# UNPACK #-} !Int Bool [a]
+
+data LenListAnd a b = {-# UNPACK #-} !(LenList a) :% b
+
+data Stack a
+ = End
+ | {-# UNPACK #-} !(LenList a) :& (Stack a)
+
+msortBy :: (a -> a -> Ordering) -> [a] -> [a]
+msortBy cmp = mergeSplit End where
+ splitAsc n _ _ _ | n `seq` False = undefined
+ splitAsc n as _ [] = LL n True as :% []
+ splitAsc n as a bs@(b:bs') = case cmp a b of
+ GT -> LL n False as :% bs
+ _ -> splitAsc (n + 1) as b bs'
+
+ splitDesc n _ _ _ | n `seq` False = undefined
+ splitDesc n rs a [] = LL n True (a:rs) :% []
+ splitDesc n rs a bs@(b:bs') = case cmp a b of
+ GT -> splitDesc (n + 1) (a:rs) b bs'
+ _ -> LL n True (a:rs) :% bs
+
+ mergeLL (LL na fa as) (LL nb fb bs) = LL (na + nb) True $ mergeLs na as nb bs where
+ mergeLs nx _ ny _ | nx `seq` ny `seq` False = undefined
+ mergeLs 0 _ ny ys = if fb then ys else take ny ys
+ mergeLs _ [] ny ys = if fb then ys else take ny ys
+ mergeLs nx xs 0 _ = if fa then xs else take nx xs
+ mergeLs nx xs _ [] = if fa then xs else take nx xs
+ mergeLs nx xs@(x:xs') ny ys@(y:ys') = case cmp x y of
+ GT -> y:mergeLs nx xs (ny - 1) ys'
+ _ -> x:mergeLs (nx - 1) xs' ny ys
+
+ push ssx px@(LL nx _ _) = case ssx of
+ End -> px :% ssx
+ py@(LL ny _ _) :& ssy -> case ssy of
+ End
+ | nx >= ny -> mergeLL py px :% ssy
+ pz@(LL nz _ _) :& ssz
+ | nx >= ny || nx + ny >= nz -> case nx > nz of
+ False -> push ssy $ mergeLL py px
+ _ -> case push ssz $ mergeLL pz py of
+ pz' :% ssz' -> push (pz' :& ssz') px
+ _ -> px :% ssx
+
+ mergeAll _ px | px `seq` False = undefined
+ mergeAll ssx px@(LL nx _ xs) = case ssx of
+ End -> xs
+ py@(LL _ _ _) :& ssy -> case ssy of
+ End -> case mergeLL py px of
+ LL _ _ xys -> xys
+ pz@(LL nz _ _) :& ssz -> case nx > nz of
+ False -> mergeAll ssy $ mergeLL py px
+ _ -> case push ssz $ mergeLL pz py of
+ pz' :% ssz' -> mergeAll (pz' :& ssz') px
+
+ mergeSplit ss _ | ss `seq` False = undefined
+ mergeSplit ss [] = case ss of
+ End -> []
+ px :& ss' -> mergeAll ss' px
+ mergeSplit ss as@(a:as') = case as' of
+ [] -> mergeAll ss $ LL 1 True as
+ b:bs -> case cmp a b of
+ GT -> case splitDesc 2 [a] b bs of
+ px :% rs -> case push ss px of
+ px' :% ss' -> mergeSplit (px' :& ss') rs
+ _ -> case splitAsc 2 as b bs of
+ px :% rs -> case push ss px of
+ px' :% ss' -> mergeSplit (px' :& ss') rs
+ {-# INLINABLE mergeSplit #-}
diff --git a/testsuite/tests/simplCore/should_compile/T14779a.hs b/testsuite/tests/simplCore/should_compile/T14779a.hs new file mode 100644 index 0000000000..f2072dc92b --- /dev/null +++ b/testsuite/tests/simplCore/should_compile/T14779a.hs @@ -0,0 +1,34 @@ +{-# OPTIONS_GHC -g -O #-} +{-# OPTIONS + -fno-strictness + -fno-case-merge + -fno-call-arity + -fno-case-folding + -fno-cse + -fno-do-eta-reduction + -fno-do-lambda-eta-expansion + -fno-float-in + -ffull-laziness + -fno-enable-rewrite-rules +#-} +-- This used to fail with: +-- +-- *** Core Lint errors : in result of Simplifier *** +-- <no location info>: warning: +-- [RHS of str_sZr :: Addr#] +-- Recursive or top-level binder has strict demand info: str_sZr +-- Binder's demand info: <L,U> +module T14779a where + +mkConstr :: String -> String +mkConstr str = r + where + r = idx `seq` str + idx = eqS r str `seq` [r] + +conMkFixed :: String +conMkFixed = mkConstr "MkFixed" + +eqS :: String -> String -> Bool +eqS [] [] = True +eqS _ _ = False diff --git a/testsuite/tests/simplCore/should_compile/T14779b.hs b/testsuite/tests/simplCore/should_compile/T14779b.hs new file mode 100644 index 0000000000..b3f0ec266b --- /dev/null +++ b/testsuite/tests/simplCore/should_compile/T14779b.hs @@ -0,0 +1,83 @@ +{-# OPTIONS_GHC -g -O #-} +-- This used to fail with: +-- +-- *** Core Lint errors : in result of Simplifier *** +-- <no location info>: warning: +-- [RHS of str_s2UI :: Addr#] +-- The type of this binder is unlifted: str_s2UI +-- Binder's type: Addr# + +module T14779b where + +data DataType = DataType + { tycon :: String + , datarep :: DataRep + } + +data Constr = Constr + { conrep :: ConstrRep + , constring :: String + , confields :: [String] -- for AlgRep only + , confixity :: Fixity -- for AlgRep only + , datatype :: DataType + } + +data DataRep = AlgRep [Constr] + | IntRep + | FloatRep + | CharRep + | NoRep + +data ConstrRep = AlgConstr ConIndex + | IntConstr Integer + | FloatConstr Rational + | CharConstr Char + +type ConIndex = Int + + +-- | Fixity of constructors +data Fixity = Prefix + | Infix -- Later: add associativity and precedence + + +mkDataType :: String -> [Constr] -> DataType +mkDataType str cs = DataType + { tycon = str + , datarep = AlgRep cs + } + +mkConstr :: DataType -> String -> [String] -> Fixity -> Constr +mkConstr dt str fields fix = + Constr + { conrep = AlgConstr idx + , constring = str + , confields = fields + , confixity = fix + , datatype = dt + } + where + idx = head [ i | (c,i) <- dataTypeConstrs dt `zip` [1..], + showConstr c == str ] + +dataTypeConstrs :: DataType -> [Constr] +dataTypeConstrs dt = case datarep dt of + (AlgRep cons) -> cons + _ -> errorWithoutStackTrace $ + "Data.Data.dataTypeConstrs is not supported for " + ++ dataTypeName dt ++ + ", as it is not an algebraic data type." +dataTypeName :: DataType -> String +dataTypeName = tycon + +showConstr :: Constr -> String +showConstr = constring + +-- | The type parameter should be an instance of 'HasResolution'. +newtype Fixed a = MkFixed Integer -- ^ @since 4.7.0.0 + deriving (Eq,Ord) + +tyFixed :: DataType +tyFixed = mkDataType "Data.Fixed.Fixed" [conMkFixed] +conMkFixed :: Constr +conMkFixed = mkConstr tyFixed "MkFixed" [] Prefix diff --git a/testsuite/tests/simplCore/should_compile/T14959.hs b/testsuite/tests/simplCore/should_compile/T14959.hs new file mode 100644 index 0000000000..692dfdd2ea --- /dev/null +++ b/testsuite/tests/simplCore/should_compile/T14959.hs @@ -0,0 +1,5 @@ +module T14959 where + +import Data.Bits (setBit) + +f = foldl setBit 0 [x | (x,_) <- zip [0..] [1]] :: Integer diff --git a/testsuite/tests/simplCore/should_compile/T14978.hs b/testsuite/tests/simplCore/should_compile/T14978.hs new file mode 100644 index 0000000000..3fedb960d8 --- /dev/null +++ b/testsuite/tests/simplCore/should_compile/T14978.hs @@ -0,0 +1,12 @@ +{-# LANGUAGE GADTs #-} +module T14978 where + +data Equal a b where + Refl :: Equal a a + +data Goof a where + Goof :: {-# UNPACK #-} !(Equal a Int) -> Goof a + + +foo :: Goof Int +foo = Goof Refl diff --git a/testsuite/tests/simplCore/should_compile/T14978.stdout b/testsuite/tests/simplCore/should_compile/T14978.stdout new file mode 100644 index 0000000000..1b12ead299 --- /dev/null +++ b/testsuite/tests/simplCore/should_compile/T14978.stdout @@ -0,0 +1,2 @@ +foo :: Goof Int +foo = T14978.Goof @ Int @~ <Co:1> diff --git a/testsuite/tests/simplCore/should_compile/T15002.hs b/testsuite/tests/simplCore/should_compile/T15002.hs new file mode 100644 index 0000000000..a5918c5234 --- /dev/null +++ b/testsuite/tests/simplCore/should_compile/T15002.hs @@ -0,0 +1,12 @@ +module T15002 where + +import Control.Concurrent.MVar (MVar, modifyMVar_, putMVar) +import Data.Foldable (for_) + +broadcastThen :: Either [MVar a] a -> MVar (Either [MVar a] a) -> a -> IO () +broadcastThen finalState mv x = + modifyMVar_ mv $ \mx -> do + case mx of + Left ls -> do for_ ls (`putMVar` x) + return finalState + Right _ -> return finalState diff --git a/testsuite/tests/simplCore/should_compile/T15005.hs b/testsuite/tests/simplCore/should_compile/T15005.hs new file mode 100644 index 0000000000..e59f49fe4b --- /dev/null +++ b/testsuite/tests/simplCore/should_compile/T15005.hs @@ -0,0 +1,189 @@ +module T15005 ( + OrderCell, + ElementCell, + rawAlgorithm, + rawAlgorithmWithSize + ) where + +-- Control + +import Control.Applicative +import Control.Monad +import Control.Monad.ST + +-- Data + +import Data.Word +import Data.Bits +import Data.STRef + +type RawOrder s o = STRef s (o s) + +type RawElement s e = STRef s (e s) + +data RawAlgorithm s o e = RawAlgorithm { + newOrder :: ST s (RawOrder s o), + compareElements :: RawElement s e -> RawElement s e -> RawOrder s o -> ST s Ordering, + newMinimum :: RawOrder s o -> ST s (RawElement s e), + newMaximum :: RawOrder s o -> ST s (RawElement s e), + newAfter :: RawElement s e -> RawOrder s o -> ST s (RawElement s e), + newBefore :: RawElement s e -> RawOrder s o -> ST s (RawElement s e), + delete :: RawElement s e -> RawOrder s o -> ST s () +} +{-FIXME: + If we ever allow users to plug in their own algorithms, we have to flag the + respective function as unsafe and point out that referential transparency is + in danger if the algorithm does not fulfill the specification. This is + because element comparison is presented to the user as a pure function. The + important condition is that for any two elements, compareElements must + always return the same result as long as delete is not called on either + element. +-} + +type OrderCell = Cell + +type ElementCell = Cell + +data Cell s = Cell { + label :: Label, + next :: CellRef s, + prev :: CellRef s + } + +type CellRef s = STRef s (Cell s) + +newtype Label = Label LabelWord deriving (Eq, Ord) + +type LabelWord = Word64 + +labelWordSize :: Int +labelWordSize = 64 + +initialBaseLabel :: Label +initialBaseLabel = Label 0 + +rawAlgorithm :: RawAlgorithm s OrderCell ElementCell +rawAlgorithm = rawAlgorithmWithSize defaultSize + +defaultSize :: Int +defaultSize = 63 + +rawAlgorithmWithSize :: Int -> RawAlgorithm s OrderCell ElementCell +rawAlgorithmWithSize size + | size < 0 || size >= labelWordSize + = error "Data.Order.Algorithm.dietzSleatorAmortizedLogWithSize: \ + \Size out of bounds" + | otherwise + = RawAlgorithm { + newOrder = fixST $ + \ ref -> newSTRef $ Cell { + label = initialBaseLabel, + next = ref, + prev = ref + }, + compareElements = \ ref1 ref2 baseRef -> do + baseCell <- readSTRef baseRef + cell1 <- readSTRef ref1 + cell2 <- readSTRef ref2 + let offset1 = labelDiff (label cell1) + (label baseCell) + let offset2 = labelDiff (label cell2) + (label baseCell) + return $ compare offset1 offset2, + newMinimum = newAfterCell, + newMaximum = newBeforeCell, + newAfter = const . newAfterCell, + newBefore = const . newBeforeCell, + delete = \ ref _ -> do + cell <- readSTRef ref + modifySTRef + (prev cell) + (\ prevCell -> prevCell { + next = next cell + }) + modifySTRef + (next cell) + (\ nextCell -> nextCell { + prev = prev cell + }) + } where + + noOfLabels :: LabelWord + noOfLabels = shiftL 1 size + + labelMask :: LabelWord + labelMask = pred noOfLabels + + toLabel :: LabelWord -> Label + toLabel = Label . (.&. labelMask) + + labelSum :: Label -> Label -> Label + labelSum (Label word1) (Label word2) = toLabel (word1 + word2) + + labelDiff :: Label -> Label -> Label + labelDiff (Label word1) (Label word2) = toLabel (word1 - word2) + + labelDistance :: Label -> Label -> LabelWord + labelDistance lbl1 lbl2 = case labelDiff lbl1 lbl2 of + Label word | word == 0 -> noOfLabels + | otherwise -> word + + newAfterCell :: CellRef s -> ST s (CellRef s) + newAfterCell ref = do + relabel ref + lbl <- label <$> readSTRef ref + nextRef <- next <$> readSTRef ref + nextLbl <- label <$> readSTRef nextRef + newRef <- newSTRef $ Cell { + label = labelSum lbl (Label (labelDistance nextLbl lbl `div` 2)), + next = nextRef, + prev = ref + } + modifySTRef ref (\ cell -> cell { next = newRef }) + modifySTRef nextRef (\ nextCell -> nextCell { prev = newRef }) + return newRef + + relabel :: CellRef s -> ST s () + relabel startRef = do + startCell <- readSTRef startRef + let delimSearch ref gapCount = do + cell <- readSTRef ref + let gapSum = labelDistance (label cell) (label startCell) + if gapSum <= gapCount ^ 2 + then if ref == startRef + then error "Data.Order.Algorithm.\ + \dietzSleatorAmortizedLogWithSize: \ + \Order full" + else delimSearch (next cell) (succ gapCount) + else return (ref, gapSum, gapCount) + (delimRef, gapSum, gapCount) <- delimSearch (next startCell) 1 + let smallGap = gapSum `div` gapCount + let largeGapCount = gapSum `mod` gapCount + let changeLabels ref ix = when (ref /= delimRef) $ do + cell <- readSTRef ref + let lbl = labelSum + (label startCell) + (Label (ix * smallGap + min largeGapCount ix)) + writeSTRef ref (cell { label = lbl }) + changeLabels (next cell) (succ ix) + changeLabels (next startCell) 1 + {-FIXME: + We allow the number of cells to be larger than the square root of the + number of possible labels as long as we find a sparse part in our circle + of cells (since our order full condition is only true if the complete + circle is congested). This should not influence correctness and probably + also not time complexity, but we should check this more thoroughly. + -} + {-FIXME: + We arrange the large and small gaps differently from Dietz and Sleator + by putting all the large gaps at the beginning instead of distributing + them over the relabeled area. However, this should not influence time + complexity, as the complexity proof seems to only rely on the fact that + gap sizes differ by at most 1. We should check this more thoroughly + though. + -} + + newBeforeCell :: CellRef s -> ST s (CellRef s) + newBeforeCell ref = do + cell <- readSTRef ref + newAfterCell (prev cell) diff --git a/testsuite/tests/simplCore/should_compile/T15056.hs b/testsuite/tests/simplCore/should_compile/T15056.hs new file mode 100644 index 0000000000..e65f73a3cf --- /dev/null +++ b/testsuite/tests/simplCore/should_compile/T15056.hs @@ -0,0 +1,6 @@ +module T15056 where + +import T15056a + +blam x = foo 3 [1..x] +-- We expect fold/build to fire diff --git a/testsuite/tests/simplCore/should_compile/T15056.stderr b/testsuite/tests/simplCore/should_compile/T15056.stderr new file mode 100644 index 0000000000..1b8c0c8101 --- /dev/null +++ b/testsuite/tests/simplCore/should_compile/T15056.stderr @@ -0,0 +1,9 @@ +Rule fired: Class op - (BUILTIN) +Rule fired: Class op + (BUILTIN) +Rule fired: Class op + (BUILTIN) +Rule fired: Class op enumFromTo (BUILTIN) +Rule fired: Class op foldr (BUILTIN) +Rule fired: Class op foldr (BUILTIN) +Rule fired: +# (BUILTIN) +Rule fired: Class op foldr (BUILTIN) +Rule fired: fold/build (GHC.Base) diff --git a/testsuite/tests/simplCore/should_compile/T15056a.hs b/testsuite/tests/simplCore/should_compile/T15056a.hs new file mode 100644 index 0000000000..6883a90e4b --- /dev/null +++ b/testsuite/tests/simplCore/should_compile/T15056a.hs @@ -0,0 +1,11 @@ +module T15056a where + +test :: Int -> Bool +test 0 = True +test n = test (n-1) + +foo :: Foldable t => Int -> t Int -> Int +foo n xs | test n + = foldr (+) n xs + | otherwise + = n+7 diff --git a/testsuite/tests/simplCore/should_compile/T15186.hs b/testsuite/tests/simplCore/should_compile/T15186.hs new file mode 100644 index 0000000000..c04de6adfa --- /dev/null +++ b/testsuite/tests/simplCore/should_compile/T15186.hs @@ -0,0 +1,31 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE PatternSynonyms #-} +module Bar (pattern PointerExpr) where + +import T15186A + +------------------------------------------------------------------------------- + +pattern PointerExpr :: Expr tp +pattern PointerExpr <- + App (RollRecursive (EmptyAssn :> BVRepr) (App _)) + +------------------------------------------------------------------------------- + +data CrucibleType where + RecursiveType :: Ctx CrucibleType -> CrucibleType + +data TypeRepr (tp :: CrucibleType) where + BVRepr :: TypeRepr tp + TypeReprDummy :: TypeRepr tp + +data App (f :: CrucibleType -> *) (tp :: CrucibleType) where + RollRecursive :: !(Assignment TypeRepr ctx) + -> !(Expr tp) + -> App f ('RecursiveType ctx) + +data Expr (tp :: CrucibleType) + = App !(App Expr tp) + | ExprDummy diff --git a/testsuite/tests/simplCore/should_compile/T15186A.hs b/testsuite/tests/simplCore/should_compile/T15186A.hs new file mode 100644 index 0000000000..151fcec987 --- /dev/null +++ b/testsuite/tests/simplCore/should_compile/T15186A.hs @@ -0,0 +1,84 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE PatternSynonyms #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE ViewPatterns #-} +module T15186A (Ctx, Assignment, pattern EmptyAssn, pattern (:>)) where + +import Data.Kind (Type) + +data Ctx k + = EmptyCtx + | Ctx k ::> k + +type SingleCtx x = 'EmptyCtx '::> x + +type family (<+>) (x :: Ctx k) (y :: Ctx k) :: Ctx k where + x <+> 'EmptyCtx = x + x <+> (y '::> e) = (x <+> y) '::> e + +data Height = Zero | Succ Height + +data BinomialTree (h::Height) (f :: k -> Type) :: Ctx k -> Type where + Empty :: BinomialTree h f 'EmptyCtx + PlusOne :: !Int + -> !(BinomialTree ('Succ h) f x) + -> !(BalancedTree h f y) + -> BinomialTree h f (x <+> y) + PlusZero :: !Int + -> !(BinomialTree ('Succ h) f x) + -> BinomialTree h f x + +newtype Assignment (f :: k -> Type) (ctx :: Ctx k) + = Assignment (BinomialTree 'Zero f ctx) + +data AssignView f ctx where + AssignEmpty :: AssignView f 'EmptyCtx + AssignExtend :: Assignment f ctx + -> f tp + -> AssignView f (ctx '::> tp) + +data DropResult f (ctx :: Ctx k) where + DropEmpty :: DropResult f 'EmptyCtx + DropExt :: BinomialTree 'Zero f x + -> f y + -> DropResult f (x '::> y) + +data BalancedTree h (f :: k -> Type) (p :: Ctx k) where + BalLeaf :: !(f x) -> BalancedTree 'Zero f (SingleCtx x) + BalPair :: !(BalancedTree h f x) + -> !(BalancedTree h f y) + -> BalancedTree ('Succ h) f (x <+> y) + +bal_drop :: forall h f x y + . BinomialTree h f x + -> BalancedTree h f y + -> DropResult f (x <+> y) +bal_drop t (BalLeaf e) = DropExt t e +bal_drop _ (BalPair {}) = undefined + +bin_drop :: forall h f ctx + . BinomialTree h f ctx + -> DropResult f ctx +bin_drop Empty = DropEmpty +bin_drop (PlusZero _ u) = bin_drop u +bin_drop (PlusOne s t u) = + let m = case t of + Empty -> Empty + _ -> PlusZero s t + in bal_drop m u + +viewAssign :: forall f ctx . Assignment f ctx -> AssignView f ctx +viewAssign (Assignment x) = + case bin_drop x of + DropEmpty -> AssignEmpty + DropExt t v -> AssignExtend (Assignment t) v + +pattern EmptyAssn :: () => ctx ~ 'EmptyCtx => Assignment f ctx +pattern EmptyAssn <- (viewAssign -> AssignEmpty) + +pattern (:>) :: () => ctx' ~ (ctx '::> tp) => Assignment f ctx -> f tp -> Assignment f ctx' +pattern (:>) a v <- (viewAssign -> AssignExtend a v) diff --git a/testsuite/tests/simplCore/should_compile/T15445.hs b/testsuite/tests/simplCore/should_compile/T15445.hs new file mode 100644 index 0000000000..36bf61dbbb --- /dev/null +++ b/testsuite/tests/simplCore/should_compile/T15445.hs @@ -0,0 +1,8 @@ +module T15445 where + +import T15445a + + +foo :: IO () +foo = do { print (plusTwoRec [1..10 :: Int]) + ; print (plusTwoRec' [1..20 :: Int]) } diff --git a/testsuite/tests/simplCore/should_compile/T15445.stderr b/testsuite/tests/simplCore/should_compile/T15445.stderr new file mode 100644 index 0000000000..d5deac5a59 --- /dev/null +++ b/testsuite/tests/simplCore/should_compile/T15445.stderr @@ -0,0 +1,13 @@ +Rule fired: Class op + (BUILTIN) +Rule fired: Class op fromInteger (BUILTIN) +Rule fired: integerToInt (BUILTIN) +Rule fired: SPEC plusTwoRec (T15445a) +Rule fired: SPEC $fShow[] (GHC.Show) +Rule fired: Class op >> (BUILTIN) +Rule fired: Class op show (BUILTIN) +Rule fired: SPEC plusTwoRec (T15445a) +Rule fired: Class op enumFromTo (BUILTIN) +Rule fired: Class op show (BUILTIN) +Rule fired: Class op enumFromTo (BUILTIN) +Rule fired: eftIntList (GHC.Enum) +Rule fired: eftIntList (GHC.Enum) diff --git a/testsuite/tests/simplCore/should_compile/T15445a.hs b/testsuite/tests/simplCore/should_compile/T15445a.hs new file mode 100644 index 0000000000..02e5baceb5 --- /dev/null +++ b/testsuite/tests/simplCore/should_compile/T15445a.hs @@ -0,0 +1,10 @@ +module T15445a where + +{-# SPECIALIZE plusTwoRec :: [Int] -> [Int] #-} +plusTwoRec :: Num a => [a] -> [a] +plusTwoRec [] = [] +plusTwoRec (x:xs) = x+2:plusTwoRec xs + +plusTwoRec' :: Num a => [a] -> [a] +plusTwoRec' [] = [] +plusTwoRec' (x:xs) = x+2:plusTwoRec' xs diff --git a/testsuite/tests/simplCore/should_compile/T15453.hs b/testsuite/tests/simplCore/should_compile/T15453.hs new file mode 100644 index 0000000000..a452bef0df --- /dev/null +++ b/testsuite/tests/simplCore/should_compile/T15453.hs @@ -0,0 +1,25 @@ +{-# LANGUAGE ImpredicativeTypes #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeInType #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE UndecidableInstances #-} +module T15453 where + +import Data.Kind +import Data.Proxy +import Data.Type.Equality + +type family S :: Type where + S = T +type family T :: Type where + T = Int + +f :: (forall (x :: S). Proxy x) :~: (forall (x :: T). Proxy x) +f = Refl + +g :: (forall (x :: T). Proxy x) :~: (forall (x :: Int). Proxy x) +g = Refl + +h :: (forall (x :: S). Proxy x) :~: (forall (x :: Int). Proxy x) +h = f `trans` g diff --git a/testsuite/tests/simplCore/should_compile/T15517.hs b/testsuite/tests/simplCore/should_compile/T15517.hs new file mode 100644 index 0000000000..954baccd48 --- /dev/null +++ b/testsuite/tests/simplCore/should_compile/T15517.hs @@ -0,0 +1,10 @@ +{-# LANGUAGE PatternSynonyms #-} +module T15517 where + +data Nat = Z | S Nat + +pattern Zpat = Z + +sfrom :: Nat -> () -> Bool +sfrom Zpat = \_ -> False +sfrom (S Z) = \_ -> False diff --git a/testsuite/tests/simplCore/should_compile/T15517a.hs b/testsuite/tests/simplCore/should_compile/T15517a.hs new file mode 100644 index 0000000000..28ca664969 --- /dev/null +++ b/testsuite/tests/simplCore/should_compile/T15517a.hs @@ -0,0 +1,96 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE FunctionalDependencies #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE PatternSynonyms #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} +module T15517a () where + +import Data.Proxy + +newtype Rep (ki :: kon -> *) (phi :: Nat -> *) (code :: [[Atom kon]]) + = Rep (NS (PoA ki phi) code) + +data NA :: (kon -> *) -> (Nat -> *) -> Atom kon -> * where + NA_I :: (IsNat k) => phi k -> NA ki phi (I k) + NA_K :: ki k -> NA ki phi (K k) + +data NP :: (k -> *) -> [k] -> * where + NP0 :: NP p '[] + (:*) :: p x -> NP p xs -> NP p (x : xs) + +class IsNat (n :: Nat) where + getSNat :: Proxy n -> SNat n +instance IsNat Z where + getSNat _ = SZ +instance IsNat n => IsNat (S n) where + getSNat p = SS (getSNat $ proxyUnsuc p) + +proxyUnsuc :: Proxy (S n) -> Proxy n +proxyUnsuc _ = Proxy + +type PoA (ki :: kon -> *) (phi :: Nat -> *) = NP (NA ki phi) + +data Atom kon + = K kon + | I Nat + +data Nat = S Nat | Z +data SNat :: Nat -> * where + SZ :: SNat Z + SS :: SNat n -> SNat (S n) + +data Kon = KInt +data Singl (kon :: Kon) :: * where + SInt :: Int -> Singl KInt + +type family Lkup (n :: Nat) (ks :: [k]) :: k where + Lkup Z (k : ks) = k + Lkup (S n) (k : ks) = Lkup n ks + +data El :: [*] -> Nat -> * where + El :: IsNat ix => Lkup ix fam -> El fam ix + +data NS :: (k -> *) -> [k] -> * where + There :: NS p xs -> NS p (x : xs) + Here :: p x -> NS p (x : xs) + +class Family (ki :: kon -> *) (fam :: [*]) (codes :: [[[Atom kon]]]) + | fam -> ki codes , ki codes -> fam where + sfrom' :: SNat ix -> El fam ix -> Rep ki (El fam) (Lkup ix codes) + +data Rose a = a :>: [Rose a] + | Leaf a + +type FamRoseInt = '[Rose Int, [Rose Int]] + +type CodesRoseInt = + '[ '[ '[K KInt, I (S Z)], '[K KInt]], '[ '[], '[I Z, I (S Z)]]] + +pattern IdxRoseInt = SZ +pattern IdxListRoseInt = SS SZ + +pat1 :: PoA Singl (El FamRoseInt) '[I Z, I (S Z)] + -> NS (PoA Singl (El FamRoseInt)) '[ '[], '[I Z, I (S Z)]] +pat1 d = There (Here d) + +pat2 :: PoA Singl (El FamRoseInt) '[] + -> NS (PoA Singl (El FamRoseInt)) '[ '[], '[I Z, I (S Z)]] +pat2 d = Here d + +pat3 :: PoA Singl (El FamRoseInt) '[K KInt] + -> NS (PoA Singl (El FamRoseInt)) '[ '[K KInt, I (S Z)], '[K KInt]] +pat3 d = There (Here d) + +pat4 :: PoA Singl (El FamRoseInt) '[K KInt, I (S Z)] + -> NS (PoA Singl (El FamRoseInt)) '[ '[K KInt, I (S Z)], '[K KInt]] +pat4 d = Here d + +instance Family Singl FamRoseInt CodesRoseInt where + sfrom' = \case IdxRoseInt -> \case El (x :>: xs) -> Rep (pat4 (NA_K (SInt x) :* (NA_I (El xs) :* NP0))) + El (Leaf x) -> Rep (pat3 (NA_K (SInt x) :* NP0)) + IdxListRoseInt -> \case El [] -> Rep (pat2 NP0) + El (x:xs) -> Rep (pat1 (NA_I (El x) :* (NA_I (El xs) :* NP0))) diff --git a/testsuite/tests/simplCore/should_compile/T15631.hs b/testsuite/tests/simplCore/should_compile/T15631.hs new file mode 100644 index 0000000000..55f67583cf --- /dev/null +++ b/testsuite/tests/simplCore/should_compile/T15631.hs @@ -0,0 +1,11 @@ +{-# Language PartialTypeSignatures, RankNTypes #-} + +module Foo where + +f xs = let ys = reverse xs + in ys `seq` + let w = length xs + in w + length (reverse (case ys of { a:as -> as; [] -> [] })) + + + diff --git a/testsuite/tests/simplCore/should_compile/T15631.stdout b/testsuite/tests/simplCore/should_compile/T15631.stdout new file mode 100644 index 0000000000..5a096f25f5 --- /dev/null +++ b/testsuite/tests/simplCore/should_compile/T15631.stdout @@ -0,0 +1,7 @@ + case GHC.List.$wlenAcc + case GHC.List.$wlenAcc @ a w 0# of ww2 { __DEFAULT -> + case GHC.List.reverse1 @ a w (GHC.Types.[] @ a) of { + [] -> case Foo.f1 @ a of { GHC.Types.I# v1 -> GHC.Prim.+# ww2 v1 }; + case GHC.List.$wlenAcc + case Foo.$wf @ a w of ww [Occ=Once] { __DEFAULT -> + case Foo.$wf @ a w of ww { __DEFAULT -> GHC.Types.I# ww } diff --git a/testsuite/tests/simplCore/should_compile/T3234.stderr b/testsuite/tests/simplCore/should_compile/T3234.stderr deleted file mode 100644 index 0e5dc178cf..0000000000 --- a/testsuite/tests/simplCore/should_compile/T3234.stderr +++ /dev/null @@ -1,71 +0,0 @@ - -==================== FloatOut stats: ==================== -2 Lets floated to top level; 0 Lets floated elsewhere; from 1 Lambda groups - - - -==================== FloatOut stats: ==================== -0 Lets floated to top level; 0 Lets floated elsewhere; from 0 Lambda groups - - - -==================== Grand total simplifier statistics ==================== -Total ticks: 55 - -18 PreInlineUnconditionally - 1 g - 1 xs - 1 ys - 1 c - 1 n - 1 a - 1 a - 1 g - 1 h - 1 n - 1 k - 1 z - 1 g - 1 c - 1 n - 1 lvl - 1 lvl - 1 lvl -1 PostInlineUnconditionally 1 c -1 UnfoldingDone 1 GHC.Base.build -5 RuleFired - 1 ++ - 1 augment/build - 1 fold/build - 1 unpack - 1 unpack-list -5 LetFloatFromLet 5 -25 BetaReduction - 1 a - 1 g - 1 a - 1 xs - 1 ys - 1 b - 1 c - 1 n - 1 a - 1 b - 1 a - 1 a - 1 g - 1 h - 1 b - 1 c - 1 n - 1 b - 1 a - 1 k - 1 z - 1 g - 1 a - 1 c - 1 n -10 SimplifierDone 10 - - diff --git a/testsuite/tests/simplCore/should_compile/T3234.stdout b/testsuite/tests/simplCore/should_compile/T3234.stdout new file mode 100644 index 0000000000..725c37928d --- /dev/null +++ b/testsuite/tests/simplCore/should_compile/T3234.stdout @@ -0,0 +1 @@ + 1 fold/build
\ No newline at end of file diff --git a/testsuite/tests/simplCore/should_compile/T3717.stderr b/testsuite/tests/simplCore/should_compile/T3717.stderr index 9bcc4f31ac..45fdf89bb4 100644 --- a/testsuite/tests/simplCore/should_compile/T3717.stderr +++ b/testsuite/tests/simplCore/should_compile/T3717.stderr @@ -44,24 +44,24 @@ T3717.$trModule :: GHC.Types.Module Str=m, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 30}] -T3717.$trModule = - GHC.Types.Module T3717.$trModule3 T3717.$trModule1 +T3717.$trModule + = GHC.Types.Module T3717.$trModule3 T3717.$trModule1 Rec { -- RHS size: {terms: 10, types: 2, coercions: 0, joins: 0/0} -T3717.$wfoo [InlPrag=[0], Occ=LoopBreaker] +T3717.$wfoo [InlPrag=NOUSERINLINE[2], Occ=LoopBreaker] :: GHC.Prim.Int# -> GHC.Prim.Int# -[GblId, Arity=1, Caf=NoCafRefs, Str=<S,1*U>] -T3717.$wfoo = - \ (ww :: GHC.Prim.Int#) -> - case ww of ds { - __DEFAULT -> T3717.$wfoo (GHC.Prim.-# ds 1#); - 0# -> 0# - } +[GblId, Arity=1, Caf=NoCafRefs, Str=<S,1*U>, Unf=OtherCon []] +T3717.$wfoo + = \ (ww :: GHC.Prim.Int#) -> + case ww of ds { + __DEFAULT -> T3717.$wfoo (GHC.Prim.-# ds 1#); + 0# -> 0# + } end Rec } -- RHS size: {terms: 10, types: 4, coercions: 0, joins: 0/0} -foo [InlPrag=INLINE[0]] :: Int -> Int +foo [InlPrag=NOUSERINLINE[2]] :: Int -> Int [GblId, Arity=1, Caf=NoCafRefs, @@ -71,13 +71,15 @@ foo [InlPrag=INLINE[0]] :: Int -> Int Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=False) Tmpl= \ (w [Occ=Once!] :: Int) -> case w of { GHC.Types.I# ww1 [Occ=Once] -> - case T3717.$wfoo ww1 of ww2 { __DEFAULT -> GHC.Types.I# ww2 } + case T3717.$wfoo ww1 of ww2 [Occ=Once] { __DEFAULT -> + GHC.Types.I# ww2 + } }}] -foo = - \ (w :: Int) -> - case w of { GHC.Types.I# ww1 -> - case T3717.$wfoo ww1 of ww2 { __DEFAULT -> GHC.Types.I# ww2 } - } +foo + = \ (w :: Int) -> + case w of { GHC.Types.I# ww1 -> + case T3717.$wfoo ww1 of ww2 { __DEFAULT -> GHC.Types.I# ww2 } + } diff --git a/testsuite/tests/simplCore/should_compile/T3772.stdout b/testsuite/tests/simplCore/should_compile/T3772.stdout index a4ab97da38..37d5a3c742 100644 --- a/testsuite/tests/simplCore/should_compile/T3772.stdout +++ b/testsuite/tests/simplCore/should_compile/T3772.stdout @@ -50,7 +50,7 @@ T3772.$trModule Rec { -- RHS size: {terms: 10, types: 2, coercions: 0, joins: 0/0} $wxs :: GHC.Prim.Int# -> () -[GblId, Arity=1, Caf=NoCafRefs, Str=<S,1*U>] +[GblId, Arity=1, Caf=NoCafRefs, Str=<S,1*U>, Unf=OtherCon []] $wxs = \ (ww :: GHC.Prim.Int#) -> case ww of ds1 { @@ -61,7 +61,7 @@ end Rec } -- RHS size: {terms: 10, types: 2, coercions: 0, joins: 0/0} T3772.$wfoo [InlPrag=NOINLINE] :: GHC.Prim.Int# -> () -[GblId, Arity=1, Caf=NoCafRefs, Str=<S,U>] +[GblId, Arity=1, Caf=NoCafRefs, Str=<S,U>, Unf=OtherCon []] T3772.$wfoo = \ (ww :: GHC.Prim.Int#) -> case GHC.Prim.<# 0# ww of { @@ -70,7 +70,7 @@ T3772.$wfoo } -- RHS size: {terms: 6, types: 3, coercions: 0, joins: 0/0} -foo [InlPrag=INLINE[0]] :: Int -> () +foo [InlPrag=NOUSERINLINE[0]] :: Int -> () [GblId, Arity=1, Caf=NoCafRefs, diff --git a/testsuite/tests/simplCore/should_compile/T4306.stdout b/testsuite/tests/simplCore/should_compile/T4306.stdout index 3d52e94830..b2a93ff1cc 100644 --- a/testsuite/tests/simplCore/should_compile/T4306.stdout +++ b/testsuite/tests/simplCore/should_compile/T4306.stdout @@ -1 +1 @@ - $wupd :: Double# -> Double# + $wupd :: GHC.Prim.Double# -> GHC.Prim.Double# diff --git a/testsuite/tests/simplCore/should_compile/T4398.stderr b/testsuite/tests/simplCore/should_compile/T4398.stderr index e1fa710a43..c9b89ca6b4 100644 --- a/testsuite/tests/simplCore/should_compile/T4398.stderr +++ b/testsuite/tests/simplCore/should_compile/T4398.stderr @@ -2,21 +2,5 @@ T4398.hs:6:11: warning: Forall'd constraint ‘Ord a’ is not bound in RULE lhs Orig bndrs: [a, $dOrd, x, y] - Orig lhs: let { - $dEq :: Eq a - [LclId] - $dEq = GHC.Classes.$p1Ord @ a $dOrd } in - f @ a - ((\ ($dOrd :: Ord a) -> - let { - $dEq :: Eq a - [LclId] - $dEq = GHC.Classes.$p1Ord @ a $dOrd } in - let { - $dEq :: Eq a - [LclId] - $dEq = GHC.Classes.$p1Ord @ a $dOrd } in - x) - $dOrd) - y + Orig lhs: f @ a ((\ ($dOrd :: Ord a) -> x) $dOrd) y optimised lhs: f @ a x y diff --git a/testsuite/tests/simplCore/should_compile/T4903a.hs b/testsuite/tests/simplCore/should_compile/T4903a.hs index 8c8700038e..df6cb5bd32 100644 --- a/testsuite/tests/simplCore/should_compile/T4903a.hs +++ b/testsuite/tests/simplCore/should_compile/T4903a.hs @@ -8,18 +8,20 @@ module T4903a where +import Data.Kind + class El phi ix where proof :: phi ix class Fam phi where from :: phi ix -> ix -> PF phi I0 ix -type family PF (phi :: * -> *) :: (* -> *) -> * -> * +type family PF (phi :: Type -> Type) :: (Type -> Type) -> Type -> Type data I0 a = I0 a -data I xi (r :: * -> *) ix = I (r xi) -data (f :*: g) (r :: * -> *) ix = f r ix :*: g r ix +data I xi (r :: Type -> Type) ix = I (r xi) +data (f :*: g) (r :: Type -> Type) ix = f r ix :*: g r ix class HEq phi f where heq :: (forall ix. phi ix -> r ix -> Bool) @@ -45,7 +47,7 @@ tree :: Tree -- The problem only occurs on an inifite (or very large) structure tree = Bin tree tree -data TreeF :: * -> * where Tree :: TreeF Tree +data TreeF :: Type -> Type where Tree :: TreeF Tree type instance PF TreeF = I Tree :*: I Tree -- If the representation is only |I Tree| then there is no problem diff --git a/testsuite/tests/simplCore/should_compile/T4908.stderr b/testsuite/tests/simplCore/should_compile/T4908.stderr index 185b9b3529..62f300e962 100644 --- a/testsuite/tests/simplCore/should_compile/T4908.stderr +++ b/testsuite/tests/simplCore/should_compile/T4908.stderr @@ -44,50 +44,54 @@ T4908.$trModule :: Module Str=m, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 30}] -T4908.$trModule = - GHC.Types.Module T4908.$trModule3 T4908.$trModule1 +T4908.$trModule + = GHC.Types.Module T4908.$trModule3 T4908.$trModule1 Rec { -- RHS size: {terms: 19, types: 5, coercions: 0, joins: 0/0} T4908.f_$s$wf [Occ=LoopBreaker] :: Int -> Int# -> Int# -> Bool -[GblId, Arity=3, Caf=NoCafRefs, Str=<L,A><L,1*U><S,1*U>] -T4908.f_$s$wf = - \ (sc :: Int) (sc1 :: Int#) (sc2 :: Int#) -> - case sc2 of ds { - __DEFAULT -> - case sc1 of ds1 { - __DEFAULT -> T4908.f_$s$wf sc ds1 (-# ds 1#); - 0# -> GHC.Types.True - }; - 0# -> GHC.Types.True - } +[GblId, + Arity=3, + Caf=NoCafRefs, + Str=<L,A><L,1*U><S,1*U>, + Unf=OtherCon []] +T4908.f_$s$wf + = \ (sc :: Int) (sc1 :: Int#) (sc2 :: Int#) -> + case sc2 of ds { + __DEFAULT -> + case sc1 of ds1 { + __DEFAULT -> T4908.f_$s$wf sc ds1 (-# ds 1#); + 0# -> GHC.Types.True + }; + 0# -> GHC.Types.True + } end Rec } -- RHS size: {terms: 24, types: 13, coercions: 0, joins: 0/0} -T4908.$wf [InlPrag=[0]] :: Int# -> (Int, Int) -> Bool +T4908.$wf [InlPrag=NOUSERINLINE[2]] :: Int# -> (Int, Int) -> Bool [GblId, Arity=2, Caf=NoCafRefs, Str=<S,1*U><L,1*U(A,1*U(1*U))>, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [30 20] 101 20}] -T4908.$wf = - \ (ww :: Int#) (w :: (Int, Int)) -> - case ww of ds { - __DEFAULT -> - case w of { (a, b) -> - case b of { I# ds1 -> - case ds1 of ds2 { - __DEFAULT -> T4908.f_$s$wf a ds2 (-# ds 1#); - 0# -> GHC.Types.True - } - } - }; - 0# -> GHC.Types.True - } +T4908.$wf + = \ (ww :: Int#) (w :: (Int, Int)) -> + case ww of ds { + __DEFAULT -> + case w of { (a, b) -> + case b of { I# ds1 -> + case ds1 of ds2 { + __DEFAULT -> T4908.f_$s$wf a ds2 (-# ds 1#); + 0# -> GHC.Types.True + } + } + }; + 0# -> GHC.Types.True + } -- RHS size: {terms: 8, types: 6, coercions: 0, joins: 0/0} -f [InlPrag=INLINE[0]] :: Int -> (Int, Int) -> Bool +f [InlPrag=NOUSERINLINE[2]] :: Int -> (Int, Int) -> Bool [GblId, Arity=2, Caf=NoCafRefs, @@ -97,13 +101,12 @@ f [InlPrag=INLINE[0]] :: Int -> (Int, Int) -> Bool Guidance=ALWAYS_IF(arity=2,unsat_ok=True,boring_ok=False) Tmpl= \ (w [Occ=Once!] :: Int) (w1 [Occ=Once] :: (Int, Int)) -> case w of { I# ww1 [Occ=Once] -> T4908.$wf ww1 w1 }}] -f = - \ (w :: Int) (w1 :: (Int, Int)) -> - case w of { I# ww1 -> T4908.$wf ww1 w1 } +f = \ (w :: Int) (w1 :: (Int, Int)) -> + case w of { I# ww1 -> T4908.$wf ww1 w1 } ------ Local rules for imported ids -------- -"SC:$wf0" [0] +"SC:$wf0" [2] forall (sc :: Int) (sc1 :: Int#) (sc2 :: Int#). T4908.$wf sc2 (sc, GHC.Types.I# sc1) = T4908.f_$s$wf sc sc1 sc2 diff --git a/testsuite/tests/simplCore/should_compile/T4918.stdout b/testsuite/tests/simplCore/should_compile/T4918.stdout index 257dbb5952..4e957c0309 100644 --- a/testsuite/tests/simplCore/should_compile/T4918.stdout +++ b/testsuite/tests/simplCore/should_compile/T4918.stdout @@ -1,2 +1,2 @@ - {- HasNoCafRefs, Strictness: m, Unfolding: (C# 'p'#) -} - {- HasNoCafRefs, Strictness: m, Unfolding: (C# 'q'#) -} + {- HasNoCafRefs, Strictness: m, Unfolding: (GHC.Types.C# 'p'#) -} + {- HasNoCafRefs, Strictness: m, Unfolding: (GHC.Types.C# 'q'#) -} diff --git a/testsuite/tests/simplCore/should_compile/T4930.stderr b/testsuite/tests/simplCore/should_compile/T4930.stderr index 4d569485b3..7556ecc9af 100644 --- a/testsuite/tests/simplCore/should_compile/T4930.stderr +++ b/testsuite/tests/simplCore/should_compile/T4930.stderr @@ -49,9 +49,9 @@ T4930.$trModule Rec { -- RHS size: {terms: 17, types: 3, coercions: 0, joins: 0/0} -T4930.$wfoo [InlPrag=[0], Occ=LoopBreaker] +T4930.$wfoo [InlPrag=NOUSERINLINE[2], Occ=LoopBreaker] :: GHC.Prim.Int# -> GHC.Prim.Int# -[GblId, Arity=1, Caf=NoCafRefs, Str=<S,U>] +[GblId, Arity=1, Caf=NoCafRefs, Str=<S,U>, Unf=OtherCon []] T4930.$wfoo = \ (ww :: GHC.Prim.Int#) -> case GHC.Prim.<# ww 5# of { @@ -61,7 +61,7 @@ T4930.$wfoo end Rec } -- RHS size: {terms: 10, types: 4, coercions: 0, joins: 0/0} -foo [InlPrag=INLINE[0]] :: Int -> Int +foo [InlPrag=NOUSERINLINE[2]] :: Int -> Int [GblId, Arity=1, Caf=NoCafRefs, @@ -71,7 +71,9 @@ foo [InlPrag=INLINE[0]] :: Int -> Int Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=False) Tmpl= \ (w [Occ=Once!] :: Int) -> case w of { GHC.Types.I# ww1 [Occ=Once] -> - case T4930.$wfoo ww1 of ww2 { __DEFAULT -> GHC.Types.I# ww2 } + case T4930.$wfoo ww1 of ww2 [Occ=Once] { __DEFAULT -> + GHC.Types.I# ww2 + } }}] foo = \ (w :: Int) -> diff --git a/testsuite/tests/simplCore/should_compile/T6056.stderr b/testsuite/tests/simplCore/should_compile/T6056.stderr index a1f022e914..e1c8aab26c 100644 --- a/testsuite/tests/simplCore/should_compile/T6056.stderr +++ b/testsuite/tests/simplCore/should_compile/T6056.stderr @@ -1,5 +1,5 @@ Rule fired: SPEC/T6056 $wsmallerAndRest @ Int (T6056) -Rule fired: Class op < (BUILTIN) Rule fired: SPEC/T6056 $wsmallerAndRest @ Int (T6056) +Rule fired: Class op < (BUILTIN) Rule fired: SPEC/T6056 $wsmallerAndRest @ Int (T6056) Rule fired: SPEC/T6056 $wsmallerAndRest @ Int (T6056) diff --git a/testsuite/tests/simplCore/should_compile/T7287.hs b/testsuite/tests/simplCore/should_compile/T7287.hs index e4a07b1bf9..bb9035a6ae 100644 --- a/testsuite/tests/simplCore/should_compile/T7287.hs +++ b/testsuite/tests/simplCore/should_compile/T7287.hs @@ -7,7 +7,7 @@ import GHC.Prim "int2Word#/word2Int#" forall x. int2Word# (word2Int# x) = x #-} -{- We get a legitmiate +{- We get a legitimate T7287.hs:7:3: warning: Rule int2Word#/word2Int# may never fire because diff --git a/testsuite/tests/simplCore/should_compile/T7360.stderr b/testsuite/tests/simplCore/should_compile/T7360.stderr index 118ebbe886..5332a3e02b 100644 --- a/testsuite/tests/simplCore/should_compile/T7360.stderr +++ b/testsuite/tests/simplCore/should_compile/T7360.stderr @@ -26,7 +26,7 @@ fun1 [InlPrag=NOINLINE] :: Foo -> () Str=<S,1*U>, Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=False) + Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=True) Tmpl= \ (x [Occ=Once] :: Foo) -> case x of { __DEFAULT -> GHC.Tuple.() }}] fun1 = \ (x :: Foo) -> case x of { __DEFAULT -> GHC.Tuple.() } @@ -57,10 +57,10 @@ fun2 :: forall a. [a] -> ((), Int) Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=False) Tmpl= \ (@ a) (x [Occ=Once!] :: [a]) -> (T7360.fun5, - case x of wild { + case x of wild [Occ=Once] { [] -> T7360.fun4; : _ [Occ=Dead] _ [Occ=Dead] -> - case GHC.List.$wlenAcc @ a wild 0# of ww2 { __DEFAULT -> + case GHC.List.$wlenAcc @ a wild 0# of ww2 [Occ=Once] { __DEFAULT -> GHC.Types.I# ww2 } })}] @@ -121,7 +121,7 @@ T7360.$trModule -- RHS size: {terms: 3, types: 1, coercions: 0, joins: 0/0} $krep :: GHC.Types.KindRep -[GblId, Caf=NoCafRefs, Str=m1] +[GblId, Caf=NoCafRefs, Str=m1, Unf=OtherCon []] $krep = GHC.Types.KindRepTyConApp GHC.Types.$tcInt (GHC.Types.[] @ GHC.Types.KindRep) @@ -160,8 +160,8 @@ T7360.$tcFoo GHC.Types.krep$* -- RHS size: {terms: 3, types: 1, coercions: 0, joins: 0/0} -T7360.$tc'Foo4 [InlPrag=[~]] :: GHC.Types.KindRep -[GblId, Caf=NoCafRefs, Str=m1] +T7360.$tc'Foo4 [InlPrag=NOUSERINLINE[~]] :: GHC.Types.KindRep +[GblId, Caf=NoCafRefs, Str=m1, Unf=OtherCon []] T7360.$tc'Foo4 = GHC.Types.KindRepTyConApp T7360.$tcFoo (GHC.Types.[] @ GHC.Types.KindRep) @@ -233,8 +233,8 @@ T7360.$tc'Foo2 T7360.$tc'Foo4 -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} -T7360.$tc'Foo9 [InlPrag=[~]] :: GHC.Types.KindRep -[GblId, Caf=NoCafRefs, Str=m4] +T7360.$tc'Foo9 [InlPrag=NOUSERINLINE[~]] :: GHC.Types.KindRep +[GblId, Caf=NoCafRefs, Str=m4, Unf=OtherCon []] T7360.$tc'Foo9 = GHC.Types.KindRepFun $krep T7360.$tc'Foo4 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} diff --git a/testsuite/tests/simplCore/should_compile/T7865.stdout b/testsuite/tests/simplCore/should_compile/T7865.stdout index 5cf005071d..4073fec7ad 100644 --- a/testsuite/tests/simplCore/should_compile/T7865.stdout +++ b/testsuite/tests/simplCore/should_compile/T7865.stdout @@ -1,7 +1,7 @@ T7865.$wexpensive [InlPrag=NOINLINE] T7865.$wexpensive -expensive [InlPrag=INLINE[0]] :: Int -> Int - case T7865.$wexpensive ww1 of ww2 { __DEFAULT -> GHC.Types.I# ww2 } +expensive [InlPrag=NOUSERINLINE[0]] :: Int -> Int + case T7865.$wexpensive ww1 of ww2 [Occ=Once] { __DEFAULT -> expensive case T7865.$wexpensive ww1 of ww2 { __DEFAULT -> GHC.Types.I# ww2 } case T7865.$wexpensive ww1 of ww2 { __DEFAULT -> diff --git a/testsuite/tests/simplCore/should_compile/T9400.stderr b/testsuite/tests/simplCore/should_compile/T9400.stderr index a8004dce8b..521b862d57 100644 --- a/testsuite/tests/simplCore/should_compile/T9400.stderr +++ b/testsuite/tests/simplCore/should_compile/T9400.stderr @@ -1,63 +1,71 @@ +T9400.hs:13:9: warning: [-Woverlapping-patterns (in -Wdefault)] + Pattern match is redundant + In a case alternative: [] -> ... + +T9400.hs:18:9: warning: [-Woverlapping-patterns (in -Wdefault)] + Pattern match is redundant + In a case alternative: "" -> ... + ==================== Tidy Core ==================== Result size of Tidy Core = {terms: 37, types: 22, coercions: 0, joins: 0/0} -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} $trModule1 :: Addr# -[GblId, Caf=NoCafRefs] +[GblId, Caf=NoCafRefs, Unf=OtherCon []] $trModule1 = "main"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} $trModule2 :: TrName -[GblId, Caf=NoCafRefs] +[GblId, Caf=NoCafRefs, Unf=OtherCon []] $trModule2 = GHC.Types.TrNameS $trModule1 -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} $trModule3 :: Addr# -[GblId, Caf=NoCafRefs] +[GblId, Caf=NoCafRefs, Unf=OtherCon []] $trModule3 = "T9400"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} $trModule4 :: TrName -[GblId, Caf=NoCafRefs] +[GblId, Caf=NoCafRefs, Unf=OtherCon []] $trModule4 = GHC.Types.TrNameS $trModule3 -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} T9400.$trModule :: Module -[GblId, Caf=NoCafRefs] +[GblId, Caf=NoCafRefs, Unf=OtherCon []] T9400.$trModule = GHC.Types.Module $trModule2 $trModule4 -- RHS size: {terms: 22, types: 15, coercions: 0, joins: 0/0} main :: IO () [GblId] -main = - >> - @ IO - GHC.Base.$fMonadIO - @ () - @ () - (putStrLn (unpackCString# "c"#)) - (>> - @ IO - GHC.Base.$fMonadIO - @ () - @ () - (putStrLn (unpackCString# "x"#)) - (>> - @ IO - GHC.Base.$fMonadIO - @ () - @ () - (putStrLn (unpackCString# "z"#)) - (>> - @ IO - GHC.Base.$fMonadIO - @ () - @ () - (putStrLn (unpackCString# "efg"#)) - (Control.Exception.Base.patError - @ 'LiftedRep @ (IO ()) "T9400.hs:(17,5)-(18,29)|case"#)))) +main + = >> + @ IO + GHC.Base.$fMonadIO + @ () + @ () + (putStrLn (unpackCString# "c"#)) + (>> + @ IO + GHC.Base.$fMonadIO + @ () + @ () + (putStrLn (unpackCString# "x"#)) + (>> + @ IO + GHC.Base.$fMonadIO + @ () + @ () + (putStrLn (unpackCString# "z"#)) + (>> + @ IO + GHC.Base.$fMonadIO + @ () + @ () + (putStrLn (unpackCString# "efg"#)) + (Control.Exception.Base.patError + @ 'LiftedRep @ (IO ()) "T9400.hs:(17,5)-(18,29)|case"#)))) diff --git a/testsuite/tests/simplCore/should_compile/T9441a.hs b/testsuite/tests/simplCore/should_compile/T9441a.hs new file mode 100644 index 0000000000..9eef17dadc --- /dev/null +++ b/testsuite/tests/simplCore/should_compile/T9441a.hs @@ -0,0 +1,9 @@ +module T9441a where + +f1 :: Integer -> Integer +f1 1 = 1 +f1 n = n * f1 (n - 1) + +f2 :: Integer -> Integer +f2 1 = 1 +f2 m = m * f2 (m - 1) diff --git a/testsuite/tests/simplCore/should_compile/T9441a.stderr b/testsuite/tests/simplCore/should_compile/T9441a.stderr new file mode 100644 index 0000000000..205ae52f29 --- /dev/null +++ b/testsuite/tests/simplCore/should_compile/T9441a.stderr @@ -0,0 +1 @@ +f1 = f2 diff --git a/testsuite/tests/simplCore/should_compile/T9441b.hs b/testsuite/tests/simplCore/should_compile/T9441b.hs new file mode 100644 index 0000000000..464c96e63f --- /dev/null +++ b/testsuite/tests/simplCore/should_compile/T9441b.hs @@ -0,0 +1,15 @@ +module T9441b where + +f1 :: Integer -> Integer +f1 n + | n <= 1 = 1 + | otherwise = go n 1 + where + go 0 r = r + go m r = go (m - 1) (r * m) + +f2 :: Integer -> Integer +f2 n = go n 1 + where + go 0 s = s + go p s = go (p - 1) (s * p) diff --git a/testsuite/tests/simplCore/should_compile/T9441b.stderr b/testsuite/tests/simplCore/should_compile/T9441b.stderr new file mode 100644 index 0000000000..10be0cda42 --- /dev/null +++ b/testsuite/tests/simplCore/should_compile/T9441b.stderr @@ -0,0 +1 @@ +Rec { diff --git a/testsuite/tests/simplCore/should_compile/T9441c.hs b/testsuite/tests/simplCore/should_compile/T9441c.hs new file mode 100644 index 0000000000..872e97e017 --- /dev/null +++ b/testsuite/tests/simplCore/should_compile/T9441c.hs @@ -0,0 +1,13 @@ +module T9441 where +-- Core output should show only one recursive Bind Rec { .. } +import GHC.Exts (build) + +{-# INLINE reverse' #-} +reverse' :: [a] -> [a] +reverse' xs = build $ \c n -> foldl (\a x -> x `c` a) n xs + +appRev :: [a] -> [a] -> [a] +appRev xs ys = xs ++ reverse' ys + +revAppRev :: [a] -> [a] -> [a] +revAppRev xs ys = reverse' xs ++ reverse' ys diff --git a/testsuite/tests/simplCore/should_compile/T9441c.stderr b/testsuite/tests/simplCore/should_compile/T9441c.stderr new file mode 100644 index 0000000000..10be0cda42 --- /dev/null +++ b/testsuite/tests/simplCore/should_compile/T9441c.stderr @@ -0,0 +1 @@ +Rec { diff --git a/testsuite/tests/simplCore/should_compile/all.T b/testsuite/tests/simplCore/should_compile/all.T index b7c8b04c5c..d572d04e15 100644 --- a/testsuite/tests/simplCore/should_compile/all.T +++ b/testsuite/tests/simplCore/should_compile/all.T @@ -44,9 +44,9 @@ test('T3016', when(fast(), skip), compile, ['']) test('T1647', normal, compile, ['-fdicts-strict -dcore-lint']) test('T3234', - only_ways(['optasm']), - compile, - ['-ddump-simpl-stats -dsuppress-uniques']) + normal, + run_command, + ['$MAKE -s --no-print-directory T3234']) test('T3717', only_ways(['optasm']), compile, @@ -113,7 +113,7 @@ test('T5168', ['$MAKE -s --no-print-directory T5168']) test('T5329', normal, compile, ['']) -test('T5303', reqlib('mtl'), compile, ['']) # Coercion-optimiation test +test('T5303', normal, compile, ['']) # Coercion-optimisation test test('T5342', normal, compile, ['']) # Lint error with -prof test('T5359a', normal, compile, ['']) # Lint error with -O (OccurAnal) test('T5359b', normal, compile, ['']) # Lint error with -O (OccurAnal) @@ -148,7 +148,6 @@ test('T7785', only_ways(['optasm']), compile, ['-ddump-rules']) test('T7702', [extra_files(['T7702plugin']), pre_cmd('$MAKE -s --no-print-directory -C T7702plugin package.T7702 TOP={top}'), - clean_cmd('$MAKE -s --no-print-directory -C T7702plugin clean.T7702'), # we say 18mb peak allocated +/- 70% because other compiler flags have # a large effect on allocation which is hard to separate from the # allocation done by the plugin... but a regression allocates > 90mb @@ -158,7 +157,16 @@ test('T7702', compile, ['-v0 -package-db T7702plugin/pkg.T7702/local.package.conf -fplugin T7702Plugin -package T7702plugin ' + config.plugin_way_flags]) -test('T7944', normal, compile, ['-O2']) +# we omit profasm because it doesn't bring much to the table but +# introduces its share of complexity, as the test as it is fails with +# profasm: +# T7944.hs:7:1: fatal: +# Cannot load -prof objects when GHC is built with -dynamic +# To fix this, either: +# (1) Use -fexternal-interpreter, or +# (2) Build the program twice: once with -dynamic, and then +# with -prof using -osuf to set a different object file suffix. +test('T7944', omit_ways(['profasm']), compile, ['-O2']) test('T7995', # RULE doesn't seem to fire unless optimizations are turned on. # This seems reasonable, so I've required it for the test. -- EZY 20130720 @@ -188,6 +196,9 @@ test('T8848a', only_ways(['optasm']), compile, ['-ddump-rules']) test('T8331', only_ways(['optasm']), compile, ['-ddump-rules']) test('T6056', only_ways(['optasm']), multimod_compile, ['T6056', '-v0 -ddump-rule-firings']) test('T9400', only_ways(['optasm']), compile, ['-O0 -ddump-simpl -dsuppress-uniques']) +test('T9441a', [only_ways(['optasm']), check_errmsg(r'f1 = f2') ], compile, ['-ddump-simpl']) +test('T9441b', [only_ways(['optasm']), check_errmsg(r'Rec {') ], compile, ['-ddump-simpl']) +test('T9441c', [only_ways(['optasm']), check_errmsg(r'Rec {') ], compile, ['-ddump-simpl']) test('T9583', only_ways(['optasm']), compile, ['']) test('T9565', only_ways(['optasm']), compile, ['']) test('T5821', only_ways(['optasm']), compile, ['']) @@ -258,7 +269,7 @@ test('T13468', normal, run_command, ['$MAKE -s --no-print-directory T13468']) -test('T13543', normal, compile, ['-ddump-str-signatures']) +test('T13543', only_ways(['optasm']), compile, ['-ddump-str-signatures']) test('T11272', normal, run_command, @@ -267,5 +278,51 @@ test('T12600', normal, run_command, ['$MAKE -s --no-print-directory T12600']) -test('T13658', normal, compile, ['-dcore-lint']) +test('T13658', + [when((arch('powerpc64') or arch('powerpc64le')), expect_broken(11261))], + compile, ['-dcore-lint']) +test('T14779a', + [when((arch('powerpc64') or arch('powerpc64le')), expect_broken(11261))], + compile, ['-dcore-lint']) +test('T14779b', + [when((arch('powerpc64') or arch('powerpc64le')), expect_broken(11261))], + compile, ['-dcore-lint']) test('T13708', normal, compile, ['']) + +# thunk should inline here, so check whether or not it appears in the Core +# (we skip profasm because it might not inline there) +test('T14137', [ check_errmsg(r'thunk'), omit_ways(['profasm']) ], compile, ['-dsuppress-uniques -ddump-simpl']) +# bar and foo should CSEd here, so check for that in the Core +test('T14186', [ only_ways(['optasm']), check_errmsg(r'bar = foo') ], compile, ['-ddump-simpl']) + +test('T14140', + normal, + run_command, + ['$MAKE -s --no-print-directory T14140']) + +test('T14272', normal, compile, ['']) +test('T14270a', normal, compile, ['']) +test('T14152', [ only_ways(['optasm']), check_errmsg(r'dead code') ], compile, ['-ddump-simpl']) +test('T14152a', [extra_files(['T14152.hs']), pre_cmd('cp T14152.hs T14152a.hs'), + only_ways(['optasm']), check_errmsg(r'dead code') ], + compile, ['-fno-exitification -ddump-simpl']) +test('T13990', normal, compile, ['-dcore-lint -O']) +test('T14650', normal, compile, ['-O2']) +test('T14959', normal, compile, ['-O']) +test('T14978', + normal, + run_command, + ['$MAKE -s --no-print-directory T14978']) +test('T15002', [ req_profiling ], compile, ['-O -fprof-auto -prof']) +test('T15005', normal, compile, ['-O']) +# we omit profiling because it affects the optimiser and makes the test fail +test('T15056', [extra_files(['T15056a.hs']), omit_ways(['profasm'])], multimod_compile, ['T15056', '-O -v0 -ddump-rule-firings']) +test('T15186', normal, multimod_compile, ['T15186', '-v0']) +test('T15517', normal, compile, ['-O0']) +test('T15517a', normal, compile, ['-O0']) +test('T15453', normal, compile, ['-dcore-lint -O1']) +test('T15445', normal, multimod_compile, ['T15445', '-v0 -O -ddump-rule-firings']) +test('T15631', + normal, + run_command, + ['$MAKE -s --no-print-directory T15631']) diff --git a/testsuite/tests/simplCore/should_compile/noinline01.stderr b/testsuite/tests/simplCore/should_compile/noinline01.stderr index 1bb98e57b4..ce01fcc863 100644 --- a/testsuite/tests/simplCore/should_compile/noinline01.stderr +++ b/testsuite/tests/simplCore/should_compile/noinline01.stderr @@ -3,11 +3,11 @@ Noinline01.f [InlPrag=INLINE (sat-args=1)] :: forall p. p -> GHC.Types.Bool [GblId, Arity=1, Caf=NoCafRefs, Str=<L,A>, Unf=OtherCon []] = - \r [eta] GHC.Types.True []; + [] \r [eta] GHC.Types.True []; Noinline01.g :: GHC.Types.Bool [GblId] = - \u [] Noinline01.f GHC.Types.False; + [] \u [] Noinline01.f GHC.Types.False; Noinline01.$trModule4 :: GHC.Prim.Addr# [GblId, Caf=NoCafRefs, Unf=OtherCon []] = @@ -15,7 +15,7 @@ Noinline01.$trModule4 :: GHC.Prim.Addr# Noinline01.$trModule3 :: GHC.Types.TrName [GblId, Caf=NoCafRefs, Str=m1, Unf=OtherCon []] = - NO_CCS GHC.Types.TrNameS! [Noinline01.$trModule4]; + CCS_DONT_CARE GHC.Types.TrNameS! [Noinline01.$trModule4]; Noinline01.$trModule2 :: GHC.Prim.Addr# [GblId, Caf=NoCafRefs, Unf=OtherCon []] = @@ -23,12 +23,12 @@ Noinline01.$trModule2 :: GHC.Prim.Addr# Noinline01.$trModule1 :: GHC.Types.TrName [GblId, Caf=NoCafRefs, Str=m1, Unf=OtherCon []] = - NO_CCS GHC.Types.TrNameS! [Noinline01.$trModule2]; + CCS_DONT_CARE GHC.Types.TrNameS! [Noinline01.$trModule2]; Noinline01.$trModule :: GHC.Types.Module [GblId, Caf=NoCafRefs, Str=m, Unf=OtherCon []] = - NO_CCS GHC.Types.Module! [Noinline01.$trModule3 - Noinline01.$trModule1]; + CCS_DONT_CARE GHC.Types.Module! [Noinline01.$trModule3 + Noinline01.$trModule1]; @@ -36,11 +36,11 @@ Noinline01.$trModule :: GHC.Types.Module Noinline01.f [InlPrag=INLINE (sat-args=1)] :: forall p. p -> GHC.Types.Bool [GblId, Arity=1, Caf=NoCafRefs, Str=<L,A>, Unf=OtherCon []] = - \r [eta] GHC.Types.True []; + [] \r [eta] GHC.Types.True []; Noinline01.g :: GHC.Types.Bool [GblId] = - \u [] Noinline01.f GHC.Types.False; + [] \u [] Noinline01.f GHC.Types.False; Noinline01.$trModule4 :: GHC.Prim.Addr# [GblId, Caf=NoCafRefs, Unf=OtherCon []] = @@ -48,7 +48,7 @@ Noinline01.$trModule4 :: GHC.Prim.Addr# Noinline01.$trModule3 :: GHC.Types.TrName [GblId, Caf=NoCafRefs, Str=m1, Unf=OtherCon []] = - NO_CCS GHC.Types.TrNameS! [Noinline01.$trModule4]; + CCS_DONT_CARE GHC.Types.TrNameS! [Noinline01.$trModule4]; Noinline01.$trModule2 :: GHC.Prim.Addr# [GblId, Caf=NoCafRefs, Unf=OtherCon []] = @@ -56,11 +56,11 @@ Noinline01.$trModule2 :: GHC.Prim.Addr# Noinline01.$trModule1 :: GHC.Types.TrName [GblId, Caf=NoCafRefs, Str=m1, Unf=OtherCon []] = - NO_CCS GHC.Types.TrNameS! [Noinline01.$trModule2]; + CCS_DONT_CARE GHC.Types.TrNameS! [Noinline01.$trModule2]; Noinline01.$trModule :: GHC.Types.Module [GblId, Caf=NoCafRefs, Str=m, Unf=OtherCon []] = - NO_CCS GHC.Types.Module! [Noinline01.$trModule3 - Noinline01.$trModule1]; + CCS_DONT_CARE GHC.Types.Module! [Noinline01.$trModule3 + Noinline01.$trModule1]; diff --git a/testsuite/tests/simplCore/should_compile/rule2.stderr b/testsuite/tests/simplCore/should_compile/rule2.stderr index 7444cc90a4..35bcec7835 100644 --- a/testsuite/tests/simplCore/should_compile/rule2.stderr +++ b/testsuite/tests/simplCore/should_compile/rule2.stderr @@ -10,12 +10,12 @@ ==================== Grand total simplifier statistics ==================== -Total ticks: 13 +Total ticks: 11 1 PreInlineUnconditionally 1 f 1 UnfoldingDone 1 Roman.bar 1 RuleFired 1 foo/bar -3 LetFloatFromLet 3 +1 LetFloatFromLet 1 1 EtaReduction 1 ds 6 BetaReduction 1 f diff --git a/testsuite/tests/simplCore/should_compile/spec-inline.stderr b/testsuite/tests/simplCore/should_compile/spec-inline.stderr index 53b315dc9c..78ba2b4c2d 100644 --- a/testsuite/tests/simplCore/should_compile/spec-inline.stderr +++ b/testsuite/tests/simplCore/should_compile/spec-inline.stderr @@ -1,7 +1,7 @@ ==================== Tidy Core ==================== Result size of Tidy Core - = {terms: 172, types: 62, coercions: 0, joins: 0/2} + = {terms: 150, types: 60, coercions: 0, joins: 0/0} -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} Roman.$trModule4 :: GHC.Prim.Addr# @@ -49,7 +49,7 @@ Roman.$trModule -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} lvl :: GHC.Prim.Addr# -[GblId, Caf=NoCafRefs] +[GblId, Caf=NoCafRefs, Unf=OtherCon []] lvl = "spec-inline.hs:(19,5)-(29,25)|function go"# -- RHS size: {terms: 2, types: 2, coercions: 0, joins: 0/0} @@ -59,29 +59,20 @@ Roman.foo3 = Control.Exception.Base.patError @ 'GHC.Types.LiftedRep @ Int lvl Rec { --- RHS size: {terms: 52, types: 6, coercions: 0, joins: 0/1} +-- RHS size: {terms: 40, types: 5, coercions: 0, joins: 0/0} Roman.foo_$s$wgo [Occ=LoopBreaker] :: GHC.Prim.Int# -> GHC.Prim.Int# -> GHC.Prim.Int# -[GblId, Arity=2, Caf=NoCafRefs, Str=<S,U><S,U>] +[GblId, Arity=2, Caf=NoCafRefs, Str=<L,U><S,U>, Unf=OtherCon []] Roman.foo_$s$wgo = \ (sc :: GHC.Prim.Int#) (sc1 :: GHC.Prim.Int#) -> - let { - m :: GHC.Prim.Int# - [LclId] - m = GHC.Prim.+# - (GHC.Prim.+# - (GHC.Prim.+# - (GHC.Prim.+# (GHC.Prim.+# (GHC.Prim.+# sc sc) sc) sc) sc) - sc) - sc } in case GHC.Prim.<=# sc1 0# of { __DEFAULT -> case GHC.Prim.<# sc1 100# of { __DEFAULT -> case GHC.Prim.<# sc1 500# of { __DEFAULT -> - Roman.foo_$s$wgo (GHC.Prim.+# m m) (GHC.Prim.-# sc1 1#); - 1# -> Roman.foo_$s$wgo m (GHC.Prim.-# sc1 3#) + Roman.foo_$s$wgo (GHC.Prim.*# 14# sc) (GHC.Prim.-# sc1 1#); + 1# -> Roman.foo_$s$wgo (GHC.Prim.*# 7# sc) (GHC.Prim.-# sc1 3#) }; 1# -> Roman.foo_$s$wgo sc (GHC.Prim.-# sc1 2#) }; @@ -89,30 +80,22 @@ Roman.foo_$s$wgo } end Rec } --- RHS size: {terms: 71, types: 19, coercions: 0, joins: 0/1} -Roman.$wgo [InlPrag=[0]] :: Maybe Int -> Maybe Int -> GHC.Prim.Int# +-- RHS size: {terms: 61, types: 18, coercions: 0, joins: 0/0} +Roman.$wgo [InlPrag=NOUSERINLINE[2]] + :: Maybe Int -> Maybe Int -> GHC.Prim.Int# [GblId, Arity=2, Str=<S,1*U><S,1*U>, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, - WorkFree=True, Expandable=True, Guidance=IF_ARGS [60 30] 253 0}] + WorkFree=True, Expandable=True, Guidance=IF_ARGS [61 30] 249 0}] Roman.$wgo = \ (w :: Maybe Int) (w1 :: Maybe Int) -> case w1 of { Nothing -> case Roman.foo3 of wild1 { }; Just x -> case x of { GHC.Types.I# ipv -> - let { - m :: GHC.Prim.Int# - [LclId] - m = GHC.Prim.+# - (GHC.Prim.+# - (GHC.Prim.+# - (GHC.Prim.+# (GHC.Prim.+# (GHC.Prim.+# ipv ipv) ipv) ipv) ipv) - ipv) - ipv } in case w of { - Nothing -> Roman.foo_$s$wgo m 10#; + Nothing -> Roman.foo_$s$wgo (GHC.Prim.*# 7# ipv) 10#; Just n -> case n of { GHC.Types.I# x2 -> case GHC.Prim.<=# x2 0# of { @@ -121,8 +104,8 @@ Roman.$wgo __DEFAULT -> case GHC.Prim.<# x2 500# of { __DEFAULT -> - Roman.foo_$s$wgo (GHC.Prim.+# m m) (GHC.Prim.-# x2 1#); - 1# -> Roman.foo_$s$wgo m (GHC.Prim.-# x2 3#) + Roman.foo_$s$wgo (GHC.Prim.*# 14# ipv) (GHC.Prim.-# x2 1#); + 1# -> Roman.foo_$s$wgo (GHC.Prim.*# 7# ipv) (GHC.Prim.-# x2 3#) }; 1# -> Roman.foo_$s$wgo ipv (GHC.Prim.-# x2 2#) }; @@ -134,7 +117,8 @@ Roman.$wgo } -- RHS size: {terms: 9, types: 5, coercions: 0, joins: 0/0} -Roman.foo_go [InlPrag=INLINE[0]] :: Maybe Int -> Maybe Int -> Int +Roman.foo_go [InlPrag=NOUSERINLINE[2]] + :: Maybe Int -> Maybe Int -> Int [GblId, Arity=2, Str=<S,1*U><S,1*U>m, @@ -142,7 +126,9 @@ Roman.foo_go [InlPrag=INLINE[0]] :: Maybe Int -> Maybe Int -> Int WorkFree=True, Expandable=True, Guidance=ALWAYS_IF(arity=2,unsat_ok=True,boring_ok=False) Tmpl= \ (w [Occ=Once] :: Maybe Int) (w1 [Occ=Once] :: Maybe Int) -> - case Roman.$wgo w w1 of ww { __DEFAULT -> GHC.Types.I# ww }}] + case Roman.$wgo w w1 of ww [Occ=Once] { __DEFAULT -> + GHC.Types.I# ww + }}] Roman.foo_go = \ (w :: Maybe Int) (w1 :: Maybe Int) -> case Roman.$wgo w w1 of ww { __DEFAULT -> GHC.Types.I# ww } @@ -163,7 +149,7 @@ Roman.foo1 :: Maybe Int Str=m2, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 20}] -Roman.foo1 = GHC.Base.Just @ Int Roman.foo2 +Roman.foo1 = GHC.Maybe.Just @ Int Roman.foo2 -- RHS size: {terms: 11, types: 4, coercions: 0, joins: 0/0} foo :: Int -> Int @@ -175,8 +161,8 @@ foo :: Int -> Int WorkFree=True, Expandable=True, Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=False) Tmpl= \ (n [Occ=Once!] :: Int) -> - case n of n1 { GHC.Types.I# _ [Occ=Dead] -> - Roman.foo_go (GHC.Base.Just @ Int n1) Roman.foo1 + case n of n1 [Occ=Once] { GHC.Types.I# _ [Occ=Dead] -> + Roman.foo_go (GHC.Maybe.Just @ Int n1) Roman.foo1 }}] foo = \ (n :: Int) -> @@ -186,10 +172,10 @@ foo ------ Local rules for imported ids -------- -"SC:$wgo0" [0] +"SC:$wgo0" [2] forall (sc :: GHC.Prim.Int#) (sc1 :: GHC.Prim.Int#). - Roman.$wgo (GHC.Base.Just @ Int (GHC.Types.I# sc1)) - (GHC.Base.Just @ Int (GHC.Types.I# sc)) + Roman.$wgo (GHC.Maybe.Just @ Int (GHC.Types.I# sc1)) + (GHC.Maybe.Just @ Int (GHC.Types.I# sc)) = Roman.foo_$s$wgo sc sc1 diff --git a/testsuite/tests/simplCore/should_compile/spec001.hs b/testsuite/tests/simplCore/should_compile/spec001.hs index 9af452cca1..5fb9685d05 100644 --- a/testsuite/tests/simplCore/should_compile/spec001.hs +++ b/testsuite/tests/simplCore/should_compile/spec001.hs @@ -2,7 +2,7 @@ {-# OPTIONS_GHC -O #-} -- In GHC 6.4, compiling this module gave a Core Lint failure following the --- specialier, because a function was floated out that had a RULE that +-- specialiser, because a function was floated out that had a RULE that -- mentioned another function (unpack, in fact). but the latter wasn't -- floated because we didn't take the RULES into account properly; result, -- variable out of scope. diff --git a/testsuite/tests/simplCore/should_fail/all.T b/testsuite/tests/simplCore/should_fail/all.T index 2af98875d9..8be9a2c25a 100644 --- a/testsuite/tests/simplCore/should_fail/all.T +++ b/testsuite/tests/simplCore/should_fail/all.T @@ -1,3 +1,3 @@ test('T7411', [expect_broken_for(7411, ['optasm', 'optllvm', - 'hpc', 'threaded2', 'dyn']), + 'threaded2', 'dyn']), exit_code(1)], compile_and_run, ['']) diff --git a/testsuite/tests/simplCore/should_run/T13429a.hs b/testsuite/tests/simplCore/should_run/T13429a.hs index 6a838cb79c..1c394888d6 100644 --- a/testsuite/tests/simplCore/should_run/T13429a.hs +++ b/testsuite/tests/simplCore/should_run/T13429a.hs @@ -3,7 +3,9 @@ {-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE UndecidableInstances #-} -module T13429a where -- Orignally FingerTree.hs from the ticket +module T13429a where -- Originally FingerTree.hs from the ticket + +import Data.Semigroup (Semigroup(..)) class (Monoid v) => Measured v a | a -> v where measure :: a -> v @@ -32,9 +34,11 @@ instance Foldable (FingerTree v) where foldMap f (Deep _ pr m sf) = foldMap f pr `mappend` foldMap (foldMap f) m `mappend` foldMap f sf +instance Measured v a => Semigroup (FingerTree v a) where + (<>) = (><) + instance Measured v a => Monoid (FingerTree v a) where mempty = empty - mappend = (><) empty :: Measured v a => FingerTree v a empty = Empty diff --git a/testsuite/tests/simplCore/should_run/T13750a.hs b/testsuite/tests/simplCore/should_run/T13750a.hs index 7ed72ca241..ac3806e7f9 100644 --- a/testsuite/tests/simplCore/should_run/T13750a.hs +++ b/testsuite/tests/simplCore/should_run/T13750a.hs @@ -6,14 +6,15 @@ {-# LANGUAGE ViewPatterns #-} module T13750a where +import Data.Kind (Type) import Unsafe.Coerce -type family AnyT :: * where {} -type family AnyList :: [*] where {} +type family AnyT :: Type where {} +type family AnyList :: [Type] where {} -newtype NP (xs :: [*]) = NP [AnyT] +newtype NP (xs :: [Type]) = NP [AnyT] -data IsNP (xs :: [*]) where +data IsNP (xs :: [Type]) where IsNil :: IsNP '[] IsCons :: x -> NP xs -> IsNP (x ': xs) @@ -34,9 +35,9 @@ pattern x :* xs <- (isNP -> IsCons x xs) x :* NP xs = NP (unsafeCoerce x : xs) infixr 5 :* -data NS (xs :: [[*]]) = NS !Int (NP AnyList) +data NS (xs :: [[Type]]) = NS !Int (NP AnyList) -data IsNS (xs :: [[*]]) where +data IsNS (xs :: [[Type]]) where IsZ :: NP x -> IsNS (x ': xs) IsS :: NS xs -> IsNS (x ': xs) diff --git a/testsuite/tests/simplCore/should_run/T14178.hs b/testsuite/tests/simplCore/should_run/T14178.hs new file mode 100644 index 0000000000..ef76324994 --- /dev/null +++ b/testsuite/tests/simplCore/should_run/T14178.hs @@ -0,0 +1,33 @@ +import System.Exit +import Control.Monad.Trans.State.Strict + +eval :: Int -> State Int a -> a +eval p = fst . flip runState p + +advance :: Int -> State Int () +advance = modify' . (+) + +loc :: State Int Int +loc = get + +emit1 :: State Int () +emit1 = advance 1 + +emitN :: Int -> State Int () +-- adding in the 0 case, breaks with HEAD. 8.2.1 is fine with it. +-- emitN 0 = advance 0 +emitN 0 = pure () +emitN n = advance n + +align8 :: State Int () +align8 = do + bits <- (`mod` 8) <$> loc + emitN (8 - bits) + +main :: IO () +main = do + let p = eval 0 (emit1 >> align8 >> loc) + putStrLn $ show p + if p == 8 + then putStrLn "OK" >> exitSuccess + else putStrLn "FAIL" >> exitFailure diff --git a/testsuite/tests/simplCore/should_run/T14178.stdout b/testsuite/tests/simplCore/should_run/T14178.stdout new file mode 100644 index 0000000000..f91f66e37e --- /dev/null +++ b/testsuite/tests/simplCore/should_run/T14178.stdout @@ -0,0 +1,2 @@ +8 +OK diff --git a/testsuite/tests/simplCore/should_run/T14768.hs b/testsuite/tests/simplCore/should_run/T14768.hs new file mode 100644 index 0000000000..116cb825cb --- /dev/null +++ b/testsuite/tests/simplCore/should_run/T14768.hs @@ -0,0 +1,59 @@ +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE TypeFamilies #-} + +module Main where + +import Control.Monad (forM_, liftM) +import qualified Data.Vector.Generic as G +import qualified Data.Vector.Generic.Mutable as M +import qualified Data.Vector.Primitive as P +import qualified Data.Vector.Unboxed as U +import qualified Data.Vector.Unboxed.Mutable as MU +import GHC.Exts + +vec :: U.Vector Moebius +vec = U.singleton Moebius0 + +main :: IO () +main = print $ U.head vec == U.head vec + +data Moebius = Moebius0 | Moebius1 | Moebius2 + deriving (Eq) + +fromMoebius :: Moebius -> Int +fromMoebius Moebius0 = 0 +fromMoebius Moebius1 = 1 +fromMoebius Moebius2 = 2 + +toMoebius :: Int -> Moebius +toMoebius (I# i#) = tagToEnum# i# + +newtype instance U.MVector s Moebius = MV_Moebius (P.MVector s Int) +newtype instance U.Vector Moebius = V_Moebius (P.Vector Int) + +instance U.Unbox Moebius + +instance M.MVector U.MVector Moebius where + basicLength (MV_Moebius v) = M.basicLength v + basicUnsafeSlice i n (MV_Moebius v) = MV_Moebius $ M.basicUnsafeSlice i n v + basicOverlaps (MV_Moebius v1) (MV_Moebius v2) = M.basicOverlaps v1 v2 + basicUnsafeNew n = MV_Moebius `liftM` M.basicUnsafeNew n + basicInitialize (MV_Moebius v) = M.basicInitialize v + basicUnsafeReplicate n x = MV_Moebius `liftM` M.basicUnsafeReplicate n (fromMoebius x) + basicUnsafeRead (MV_Moebius v) i = toMoebius `liftM` M.basicUnsafeRead v i + basicUnsafeWrite (MV_Moebius v) i x = M.basicUnsafeWrite v i (fromMoebius x) + basicClear (MV_Moebius v) = M.basicClear v + basicSet (MV_Moebius v) x = M.basicSet v (fromMoebius x) + basicUnsafeCopy (MV_Moebius v1) (MV_Moebius v2) = M.basicUnsafeCopy v1 v2 + basicUnsafeMove (MV_Moebius v1) (MV_Moebius v2) = M.basicUnsafeMove v1 v2 + basicUnsafeGrow (MV_Moebius v) n = MV_Moebius `liftM` M.basicUnsafeGrow v n + +instance G.Vector U.Vector Moebius where + basicUnsafeFreeze (MV_Moebius v) = V_Moebius `liftM` G.basicUnsafeFreeze v + basicUnsafeThaw (V_Moebius v) = MV_Moebius `liftM` G.basicUnsafeThaw v + basicLength (V_Moebius v) = G.basicLength v + basicUnsafeSlice i n (V_Moebius v) = V_Moebius $ G.basicUnsafeSlice i n v + basicUnsafeIndexM (V_Moebius v) i = toMoebius `liftM` G.basicUnsafeIndexM v i + basicUnsafeCopy (MV_Moebius mv) (V_Moebius v) = G.basicUnsafeCopy mv v + elemseq _ = seq diff --git a/testsuite/tests/simplCore/should_run/T14868.hs b/testsuite/tests/simplCore/should_run/T14868.hs new file mode 100644 index 0000000000..4d32c30eab --- /dev/null +++ b/testsuite/tests/simplCore/should_run/T14868.hs @@ -0,0 +1,2 @@ +{-# OPTIONS -O -g #-} +main = print (4, "foo") diff --git a/testsuite/tests/simplCore/should_run/T14868.stdout b/testsuite/tests/simplCore/should_run/T14868.stdout new file mode 100644 index 0000000000..5dfd2f7b0d --- /dev/null +++ b/testsuite/tests/simplCore/should_run/T14868.stdout @@ -0,0 +1 @@ +(4,"foo") diff --git a/testsuite/tests/simplCore/should_run/T14894.hs b/testsuite/tests/simplCore/should_run/T14894.hs new file mode 100644 index 0000000000..420b85e466 --- /dev/null +++ b/testsuite/tests/simplCore/should_run/T14894.hs @@ -0,0 +1,9 @@ +{-# OPTIONS_GHC -g1 -O #-} +import System.Environment +summap :: (Int -> Int) -> (Int -> Int) +summap f n = f 10 +{-# NOINLINE summap #-} + +main = do + n <- length `fmap` getArgs + print $ summap (+ n) n diff --git a/testsuite/tests/simplCore/should_run/T14894.stdout b/testsuite/tests/simplCore/should_run/T14894.stdout new file mode 100644 index 0000000000..f599e28b8a --- /dev/null +++ b/testsuite/tests/simplCore/should_run/T14894.stdout @@ -0,0 +1 @@ +10 diff --git a/testsuite/tests/simplCore/should_run/T14965.hs b/testsuite/tests/simplCore/should_run/T14965.hs new file mode 100644 index 0000000000..f4fa01148e --- /dev/null +++ b/testsuite/tests/simplCore/should_run/T14965.hs @@ -0,0 +1,15 @@ +module Main (main) where + +import T14965_Sep + +main :: IO () +main = print $ cc bb + +bb :: Sep +bb = catSep b1 b2 + +b1 :: Sep +b1 = Sep [] ["foo"] [] + +b2 :: Sep +b2 = Sep [] ["bar"] [] diff --git a/testsuite/tests/simplCore/should_run/T14965.stdout b/testsuite/tests/simplCore/should_run/T14965.stdout new file mode 100644 index 0000000000..0ca95142bb --- /dev/null +++ b/testsuite/tests/simplCore/should_run/T14965.stdout @@ -0,0 +1 @@ +True diff --git a/testsuite/tests/simplCore/should_run/T14965_Sep.hs b/testsuite/tests/simplCore/should_run/T14965_Sep.hs new file mode 100644 index 0000000000..46c0f1b7e4 --- /dev/null +++ b/testsuite/tests/simplCore/should_run/T14965_Sep.hs @@ -0,0 +1,13 @@ +module T14965_Sep where + +data Sep = Sep + { bugVanishesWithoutThis :: [()] + , middle :: [String] + , orThis :: [()] + } + +catSep :: Sep -> Sep -> Sep +catSep (Sep a b c) (Sep x y z) = Sep (a ++ x) (b ++ y) (c ++ z) + +cc :: Sep -> Bool +cc boost = elem "foo" $ middle boost diff --git a/testsuite/tests/simplCore/should_run/T15114.hs b/testsuite/tests/simplCore/should_run/T15114.hs new file mode 100644 index 0000000000..ef0e77c683 --- /dev/null +++ b/testsuite/tests/simplCore/should_run/T15114.hs @@ -0,0 +1,23 @@ +{-# OPTIONS_GHC -O #-} +-- Bug only showed up with optimisation on + +module Main where + +import qualified Control.Exception as Exception + +main :: IO () +main = do + unserialize + putStrLn "all is well" + +unserialize :: IO Char +unserialize = + if definitelyTrue + then do + return 'a' + else do + Exception.evaluate (error "wrong place") + +{-# NOINLINE definitelyTrue #-} +definitelyTrue :: Bool +definitelyTrue = True diff --git a/testsuite/tests/simplCore/should_run/T15114.stdout b/testsuite/tests/simplCore/should_run/T15114.stdout new file mode 100644 index 0000000000..0b9e820aee --- /dev/null +++ b/testsuite/tests/simplCore/should_run/T15114.stdout @@ -0,0 +1 @@ +all is well diff --git a/testsuite/tests/simplCore/should_run/T15436.hs b/testsuite/tests/simplCore/should_run/T15436.hs new file mode 100644 index 0000000000..a9d5df8e09 --- /dev/null +++ b/testsuite/tests/simplCore/should_run/T15436.hs @@ -0,0 +1,21 @@ +module Main where + +import GHC.Enum + +data XXX = AL | AK | AZ | AR | CA | CO | CT | DE | FL + deriving (Enum, Bounded, Show) + +data Z = Y | X XXX deriving( Show ) + +instance Enum Z where + fromEnum Y = 0 + fromEnum (X s) = 1 + fromEnum s + toEnum 0 = Y + toEnum i = X (toEnum (i - 1)) + +instance Bounded Z where + minBound = Y + maxBound = X maxBound + + +main = print [ succ (x :: Z) | x <- [minBound .. pred maxBound] ] diff --git a/testsuite/tests/simplCore/should_run/T15436.stdout b/testsuite/tests/simplCore/should_run/T15436.stdout new file mode 100644 index 0000000000..deb6836de6 --- /dev/null +++ b/testsuite/tests/simplCore/should_run/T15436.stdout @@ -0,0 +1 @@ +[X AL,X AK,X AZ,X AR,X CA,X CO,X CT,X DE,X FL] diff --git a/testsuite/tests/simplCore/should_run/T3591.hs b/testsuite/tests/simplCore/should_run/T3591.hs index 6ec51a14d5..27bb52432e 100644 --- a/testsuite/tests/simplCore/should_run/T3591.hs +++ b/testsuite/tests/simplCore/should_run/T3591.hs @@ -20,7 +20,7 @@ -- | Module "Trampoline" defines the pipe computations and their basic building blocks. {-# LANGUAGE ScopedTypeVariables, Rank2Types, MultiParamTypeClasses, - TypeFamilies, KindSignatures, FlexibleContexts, + TypeFamilies, KindSignatures, FlexibleContexts, NoMonadFailDesugaring, FlexibleInstances, OverlappingInstances, UndecidableInstances #-} diff --git a/testsuite/tests/simplCore/should_run/all.T b/testsuite/tests/simplCore/should_run/all.T index 75ff431910..a9edee2b00 100644 --- a/testsuite/tests/simplCore/should_run/all.T +++ b/testsuite/tests/simplCore/should_run/all.T @@ -77,3 +77,12 @@ test('T13733', expect_broken(13733), compile_and_run, ['']) test('T13429', normal, compile_and_run, ['']) test('T13429_2', normal, compile_and_run, ['']) test('T13750', normal, compile_and_run, ['']) +test('T14178', normal, compile_and_run, ['']) +test('T14768', reqlib('vector'), compile_and_run, ['']) +test('T14868', + [when((arch('powerpc64') or arch('powerpc64le')), expect_broken(11261))], + compile_and_run, ['']) +test('T14894', [when((arch('powerpc64') or arch('powerpc64le')), expect_broken(11261))], compile_and_run, ['']) +test('T14965', normal, compile_and_run, ['']) +test('T15114', only_ways('optasm'), compile_and_run, ['']) +test('T15436', normal, compile_and_run, ['']) diff --git a/testsuite/tests/simplCore/should_run/simplrun002.hs b/testsuite/tests/simplCore/should_run/simplrun002.hs index ec4ea7c7ac..5b9e01cc25 100644 --- a/testsuite/tests/simplCore/should_run/simplrun002.hs +++ b/testsuite/tests/simplCore/should_run/simplrun002.hs @@ -12,11 +12,11 @@ import System.IO import System.IO.Unsafe ( unsafePerformIO ) {-# NOINLINE [0] sndSnd #-} --- Dont inline till last, to give the rule a chance +-- Don't inline till last, to give the rule a chance sndSnd (a,(b,c)) = (a,c) {-# NOINLINE [2] myFst #-} --- Dont inline till last, to give the rule a chance +-- Don't inline till last, to give the rule a chance myFst (a,b) = a trace x y = unsafePerformIO (hPutStr stderr x >> hPutStr stderr "\n" >> return y) diff --git a/testsuite/tests/simplStg/should_compile/all.T b/testsuite/tests/simplStg/should_compile/all.T index 19fa5134b4..2cb89749c4 100644 --- a/testsuite/tests/simplStg/should_compile/all.T +++ b/testsuite/tests/simplStg/should_compile/all.T @@ -17,6 +17,4 @@ def checkStgString(needle): return "%s not contained in -ddump-simpl\n" % needle return normalise_errmsg_fun(norm) - - -test('T13588', [ checkStgString('case') ] , compile, ['-ddump-stg']) +test('T13588', [ checkStgString('case') ] , compile, ['-dverbose-stg2stg']) diff --git a/testsuite/tests/stranal/should_compile/T10482.stderr b/testsuite/tests/stranal/should_compile/T10482.stderr index 7f8789d5f4..47e8e102c4 100644 --- a/testsuite/tests/stranal/should_compile/T10482.stderr +++ b/testsuite/tests/stranal/should_compile/T10482.stderr @@ -1 +1,263 @@ -T10482.$wfoo [InlPrag=[0], Occ=LoopBreaker] :: GHC.Prim.Int# -> GHC.Prim.Int# -> GHC.Prim.Int# + +==================== Tidy Core ==================== +Result size of Tidy Core = {terms: 171, types: 116, coercions: 15, joins: 0/0} + +-- RHS size: {terms: 13, types: 14, coercions: 4, joins: 0/0} +T10482.$WFooPair [InlPrag=INLINE[2]] :: forall a b. Foo a -> Foo b -> Foo (a, b) +[GblId[DataConWrapper], + Arity=2, + Caf=NoCafRefs, + Str=<S,U><S,U>m, + Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, + Guidance=ALWAYS_IF(arity=2,unsat_ok=True,boring_ok=False) + Tmpl= \ (@ a_aX9) (@ b_aXa) (dt_a2pg [Occ=Once] :: Foo a_aX9[sk:2]) (dt_a2ph [Occ=Once] :: Foo b_aXa[sk:2]) -> + (case dt_a2pg of dt_X2pl { __DEFAULT -> case dt_a2ph of dt_X2pn { __DEFAULT -> T10482.FooPair @ a_aX9 @ b_aXa dt_X2pl dt_X2pn } }) + `cast` (Sym (T10482.D:R:Foo(,)0[0] <a_aX9>_N <b_aXa>_N) :: (T10482.R:Foo(,) a_aX9 b_aXa :: *) ~R# (Foo (a_aX9, b_aXa) :: *))}] +T10482.$WFooPair + = \ (@ a_aX9) (@ b_aXa) (dt_a2pg [Occ=Once] :: Foo a_aX9[sk:2]) (dt_a2ph [Occ=Once] :: Foo b_aXa[sk:2]) -> + (case dt_a2pg of dt_X2pl { __DEFAULT -> case dt_a2ph of dt_X2pn { __DEFAULT -> T10482.FooPair @ a_aX9 @ b_aXa dt_X2pl dt_X2pn } }) + `cast` (Sym (T10482.D:R:Foo(,)0[0] <a_aX9>_N <b_aXa>_N) :: (T10482.R:Foo(,) a_aX9 b_aXa :: *) ~R# (Foo (a_aX9, b_aXa) :: *)) + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +T10482.$trModule4 :: GHC.Prim.Addr# +[GblId, + Caf=NoCafRefs, + Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}] +T10482.$trModule4 = "main"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +T10482.$trModule3 :: GHC.Types.TrName +[GblId, + Caf=NoCafRefs, + Str=m1, + Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 20}] +T10482.$trModule3 = GHC.Types.TrNameS T10482.$trModule4 + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +T10482.$trModule2 :: GHC.Prim.Addr# +[GblId, + Caf=NoCafRefs, + Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 0}] +T10482.$trModule2 = "T10482"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +T10482.$trModule1 :: GHC.Types.TrName +[GblId, + Caf=NoCafRefs, + Str=m1, + Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 20}] +T10482.$trModule1 = GHC.Types.TrNameS T10482.$trModule2 + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +T10482.$trModule :: GHC.Types.Module +[GblId, + Caf=NoCafRefs, + Str=m, + Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 30}] +T10482.$trModule = GHC.Types.Module T10482.$trModule3 T10482.$trModule1 + +-- RHS size: {terms: 3, types: 1, coercions: 0, joins: 0/0} +$krep_r2Q4 :: GHC.Types.KindRep +[GblId, Caf=NoCafRefs, Str=m1, Unf=OtherCon []] +$krep_r2Q4 = GHC.Types.KindRepTyConApp GHC.Types.$tcInt (GHC.Types.[] @ GHC.Types.KindRep) + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +$krep1_r2Q5 :: GHC.Types.KindRep +[GblId, Caf=NoCafRefs, Str=m2, Unf=OtherCon []] +$krep1_r2Q5 = GHC.Types.KindRepVar 1# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +$krep2_r2Q6 :: GHC.Types.KindRep +[GblId, Caf=NoCafRefs, Str=m2, Unf=OtherCon []] +$krep2_r2Q6 = GHC.Types.KindRepVar 0# + +-- RHS size: {terms: 3, types: 2, coercions: 0, joins: 0/0} +$krep3_r2Q7 :: [GHC.Types.KindRep] +[GblId, Caf=NoCafRefs, Str=m2, Unf=OtherCon []] +$krep3_r2Q7 = GHC.Types.: @ GHC.Types.KindRep $krep1_r2Q5 (GHC.Types.[] @ GHC.Types.KindRep) + +-- RHS size: {terms: 3, types: 1, coercions: 0, joins: 0/0} +$krep4_r2Q8 :: [GHC.Types.KindRep] +[GblId, Caf=NoCafRefs, Str=m2, Unf=OtherCon []] +$krep4_r2Q8 = GHC.Types.: @ GHC.Types.KindRep $krep2_r2Q6 $krep3_r2Q7 + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +$krep5_r2Q9 :: GHC.Types.KindRep +[GblId, Caf=NoCafRefs, Str=m1, Unf=OtherCon []] +$krep5_r2Q9 = GHC.Types.KindRepTyConApp GHC.Tuple.$tc(,) $krep4_r2Q8 + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +T10482.$tcFoo2 :: GHC.Prim.Addr# +[GblId, + Caf=NoCafRefs, + Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}] +T10482.$tcFoo2 = "Foo"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +T10482.$tcFoo1 :: GHC.Types.TrName +[GblId, + Caf=NoCafRefs, + Str=m1, + Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 20}] +T10482.$tcFoo1 = GHC.Types.TrNameS T10482.$tcFoo2 + +-- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} +T10482.$tcFoo :: GHC.Types.TyCon +[GblId, + Caf=NoCafRefs, + Str=m, + Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 70}] +T10482.$tcFoo = GHC.Types.TyCon 3311038889639791302## 7944995683507700778## T10482.$trModule T10482.$tcFoo1 0# GHC.Types.krep$*Arr* + +-- RHS size: {terms: 3, types: 2, coercions: 0, joins: 0/0} +$krep6_r2Qa :: [GHC.Types.KindRep] +[GblId, Caf=NoCafRefs, Str=m2, Unf=OtherCon []] +$krep6_r2Qa = GHC.Types.: @ GHC.Types.KindRep $krep2_r2Q6 (GHC.Types.[] @ GHC.Types.KindRep) + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +$krep7_r2Qb :: GHC.Types.KindRep +[GblId, Caf=NoCafRefs, Str=m1, Unf=OtherCon []] +$krep7_r2Qb = GHC.Types.KindRepTyConApp T10482.$tcFoo $krep6_r2Qa + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +$krep8_r2Qc :: GHC.Types.KindRep +[GblId, Caf=NoCafRefs, Str=m1, Unf=OtherCon []] +$krep8_r2Qc = GHC.Types.KindRepTyConApp T10482.$tcFoo $krep3_r2Q7 + +-- RHS size: {terms: 3, types: 2, coercions: 0, joins: 0/0} +$krep9_r2Qd :: [GHC.Types.KindRep] +[GblId, Caf=NoCafRefs, Str=m2, Unf=OtherCon []] +$krep9_r2Qd = GHC.Types.: @ GHC.Types.KindRep $krep5_r2Q9 (GHC.Types.[] @ GHC.Types.KindRep) + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +$krep10_r2Qe :: GHC.Types.KindRep +[GblId, Caf=NoCafRefs, Str=m1, Unf=OtherCon []] +$krep10_r2Qe = GHC.Types.KindRepTyConApp T10482.$tcFoo $krep9_r2Qd + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +$krep11_r2Qf :: GHC.Types.KindRep +[GblId, Caf=NoCafRefs, Str=m4, Unf=OtherCon []] +$krep11_r2Qf = GHC.Types.KindRepFun $krep8_r2Qc $krep10_r2Qe + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +T10482.$tc'FooPair1 [InlPrag=NOUSERINLINE[~]] :: GHC.Types.KindRep +[GblId, Caf=NoCafRefs, Str=m4, Unf=OtherCon []] +T10482.$tc'FooPair1 = GHC.Types.KindRepFun $krep7_r2Qb $krep11_r2Qf + +-- RHS size: {terms: 3, types: 2, coercions: 0, joins: 0/0} +$krep12_r2Qg :: [GHC.Types.KindRep] +[GblId, Caf=NoCafRefs, Str=m2, Unf=OtherCon []] +$krep12_r2Qg = GHC.Types.: @ GHC.Types.KindRep $krep_r2Q4 (GHC.Types.[] @ GHC.Types.KindRep) + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +$krep13_r2Qh :: GHC.Types.KindRep +[GblId, Caf=NoCafRefs, Str=m1, Unf=OtherCon []] +$krep13_r2Qh = GHC.Types.KindRepTyConApp T10482.$tcFoo $krep12_r2Qg + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +T10482.$tc'Foo1 [InlPrag=NOUSERINLINE[~]] :: GHC.Types.KindRep +[GblId, Caf=NoCafRefs, Str=m4, Unf=OtherCon []] +T10482.$tc'Foo1 = GHC.Types.KindRepFun $krep_r2Q4 $krep13_r2Qh + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +T10482.$tc'FooPair3 :: GHC.Prim.Addr# +[GblId, + Caf=NoCafRefs, + Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 0}] +T10482.$tc'FooPair3 = "'FooPair"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +T10482.$tc'FooPair2 :: GHC.Types.TrName +[GblId, + Caf=NoCafRefs, + Str=m1, + Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 20}] +T10482.$tc'FooPair2 = GHC.Types.TrNameS T10482.$tc'FooPair3 + +-- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} +T10482.$tc'FooPair :: GHC.Types.TyCon +[GblId, + Caf=NoCafRefs, + Str=m, + Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 70}] +T10482.$tc'FooPair + = GHC.Types.TyCon 5329411373903054066## 1455261321638291317## T10482.$trModule T10482.$tc'FooPair2 2# T10482.$tc'FooPair1 + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +T10482.$tc'Foo3 :: GHC.Prim.Addr# +[GblId, + Caf=NoCafRefs, + Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}] +T10482.$tc'Foo3 = "'Foo"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +T10482.$tc'Foo2 :: GHC.Types.TrName +[GblId, + Caf=NoCafRefs, + Str=m1, + Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 20}] +T10482.$tc'Foo2 = GHC.Types.TrNameS T10482.$tc'Foo3 + +-- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} +T10482.$tc'Foo :: GHC.Types.TyCon +[GblId, + Caf=NoCafRefs, + Str=m, + Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 70}] +T10482.$tc'Foo = GHC.Types.TyCon 5096937192618987042## 15136671864408054946## T10482.$trModule T10482.$tc'Foo2 0# T10482.$tc'Foo1 + +Rec { +-- RHS size: {terms: 19, types: 4, coercions: 0, joins: 0/0} +T10482.$wfoo [InlPrag=NOUSERINLINE[2], Occ=LoopBreaker] :: GHC.Prim.Int# -> GHC.Prim.Int# -> GHC.Prim.Int# +[GblId, Arity=2, Caf=NoCafRefs, Str=<L,1*U><S,1*U>, Unf=OtherCon []] +T10482.$wfoo + = \ (ww_s2OA :: GHC.Prim.Int#) (ww1_s2OI :: GHC.Prim.Int#) -> + case ww1_s2OI of wild_X1r { + __DEFAULT -> + case GHC.Prim.remInt# wild_X1r 2# of { + __DEFAULT -> ww_s2OA; + 0# -> T10482.$wfoo ww_s2OA (GHC.Prim.-# wild_X1r 1#) + }; + 0# -> 0# + } +end Rec } + +-- RHS size: {terms: 21, types: 30, coercions: 11, joins: 0/0} +foo [InlPrag=NOUSERINLINE[2]] :: Foo ((Int, Int), Int) -> Int -> Int +[GblId, + Arity=2, + Caf=NoCafRefs, + Str=<S(S(S(S)L)L),1*U(U(U(1*U),A),A)><S(S),1*U(1*U)>m, + Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, + Guidance=ALWAYS_IF(arity=2,unsat_ok=True,boring_ok=False) + Tmpl= \ (w_s2Oq [Occ=Once] :: Foo ((Int, Int), Int)) (w1_s2Or [Occ=Once!] :: Int) -> + case w_s2Oq + `cast` (T10482.D:R:Foo(,)0[0] <(Int, Int)>_N <Int>_N :: (Foo ((Int, Int), Int) :: *) ~R# (T10482.R:Foo(,) (Int, Int) Int :: *)) + of + { FooPair ww1_s2Ou [Occ=Once] _ [Occ=Dead] -> + case ww1_s2Ou `cast` (T10482.D:R:Foo(,)0[0] <Int>_N <Int>_N :: (Foo (Int, Int) :: *) ~R# (T10482.R:Foo(,) Int Int :: *)) of + { FooPair ww4_s2Ox [Occ=Once] _ [Occ=Dead] -> + case ww4_s2Ox `cast` (T10482.D:R:FooInt0[0] ; T10482.N:R:FooInt[0] :: (Foo Int :: *) ~R# (Int :: *)) of + { GHC.Types.I# ww7_s2OA [Occ=Once] -> + case w1_s2Or of { GHC.Types.I# ww9_s2OI [Occ=Once] -> + case T10482.$wfoo ww7_s2OA ww9_s2OI of ww10_s2OM { __DEFAULT -> GHC.Types.I# ww10_s2OM } + } + } + } + }}] +foo + = \ (w_s2Oq :: Foo ((Int, Int), Int)) (w1_s2Or :: Int) -> + case w_s2Oq + `cast` (T10482.D:R:Foo(,)0[0] <(Int, Int)>_N <Int>_N :: (Foo ((Int, Int), Int) :: *) ~R# (T10482.R:Foo(,) (Int, Int) Int :: *)) + of + { FooPair ww1_s2Ou ww2_s2OE -> + case ww1_s2Ou `cast` (T10482.D:R:Foo(,)0[0] <Int>_N <Int>_N :: (Foo (Int, Int) :: *) ~R# (T10482.R:Foo(,) Int Int :: *)) of + { FooPair ww4_s2Pm ww5_s2Pn -> + case ww4_s2Pm `cast` (T10482.D:R:FooInt0[0] ; T10482.N:R:FooInt[0] :: (Foo Int :: *) ~R# (Int :: *)) of { GHC.Types.I# ww7_s2Pq -> + case w1_s2Or of { GHC.Types.I# ww9_s2OI -> case T10482.$wfoo ww7_s2Pq ww9_s2OI of ww10_s2OM { __DEFAULT -> GHC.Types.I# ww10_s2OM } } + } + } + } + + + diff --git a/testsuite/tests/stranal/should_compile/T10482a.stderr b/testsuite/tests/stranal/should_compile/T10482a.stderr index d26b45fe1a..6fa4f00d75 100644 --- a/testsuite/tests/stranal/should_compile/T10482a.stderr +++ b/testsuite/tests/stranal/should_compile/T10482a.stderr @@ -1,4 +1,486 @@ -Foo.$wf4 [InlPrag=[0], Occ=LoopBreaker] :: GHC.Prim.Int# -> GHC.Prim.Int# -> GHC.Prim.Int# -Foo.$wf2 [InlPrag=[0], Occ=LoopBreaker] :: GHC.Prim.Int# -> GHC.Prim.Int# -> GHC.Prim.Int# -Foo.$wf1 [InlPrag=[0], Occ=LoopBreaker] :: GHC.Prim.Int# -> GHC.Prim.Int# -Foo.$wf3 [InlPrag=[0], Occ=LoopBreaker] :: GHC.Prim.Int# -> GHC.Prim.Int# -> GHC.Prim.Int# + +==================== Tidy Core ==================== +Result size of Tidy Core = {terms: 353, types: 155, coercions: 3, joins: 0/0} + +-- RHS size: {terms: 9, types: 8, coercions: 0, joins: 0/0} +Foo.$WMkT4 [InlPrag=INLINE[2]] :: forall a. Foo a -> Int -> T4 a +[GblId[DataConWrapper], + Arity=2, + Caf=NoCafRefs, + Str=<S,U><L,U>m, + Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, + Guidance=ALWAYS_IF(arity=2,unsat_ok=True,boring_ok=False) + Tmpl= \ (@ a_atA) (dt_a21M [Occ=Once] :: Foo a_atA[sk:1]) (dt_a21N [Occ=Once] :: Int) -> + case dt_a21M of dt_X21Q { __DEFAULT -> Foo.MkT4 @ a_atA dt_X21Q dt_a21N }}] +Foo.$WMkT4 + = \ (@ a_atA) (dt_a21M [Occ=Once] :: Foo a_atA[sk:1]) (dt_a21N [Occ=Once] :: Int) -> + case dt_a21M of dt_X21Q { __DEFAULT -> Foo.MkT4 @ a_atA dt_X21Q dt_a21N } + +-- RHS size: {terms: 8, types: 3, coercions: 0, joins: 0/0} +Foo.$WMkT2 [InlPrag=INLINE[2]] :: Int -> Int -> T2 +[GblId[DataConWrapper], + Arity=2, + Caf=NoCafRefs, + Str=<S,U><L,U>m, + Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, + Guidance=ALWAYS_IF(arity=2,unsat_ok=True,boring_ok=False) + Tmpl= \ (dt_a20w [Occ=Once] :: Int) (dt_a20x [Occ=Once] :: Int) -> + case dt_a20w of dt_X20z { __DEFAULT -> Foo.MkT2 dt_X20z dt_a20x }}] +Foo.$WMkT2 + = \ (dt_a20w [Occ=Once] :: Int) (dt_a20x [Occ=Once] :: Int) -> case dt_a20w of dt_X20z { __DEFAULT -> Foo.MkT2 dt_X20z dt_a20x } + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +Foo.$trModule4 :: GHC.Prim.Addr# +[GblId, + Caf=NoCafRefs, + Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}] +Foo.$trModule4 = "main"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +Foo.$trModule3 :: GHC.Types.TrName +[GblId, + Caf=NoCafRefs, + Str=m1, + Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 20}] +Foo.$trModule3 = GHC.Types.TrNameS Foo.$trModule4 + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +Foo.$trModule2 :: GHC.Prim.Addr# +[GblId, + Caf=NoCafRefs, + Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}] +Foo.$trModule2 = "Foo"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +Foo.$trModule1 :: GHC.Types.TrName +[GblId, + Caf=NoCafRefs, + Str=m1, + Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 20}] +Foo.$trModule1 = GHC.Types.TrNameS Foo.$trModule2 + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +Foo.$trModule :: GHC.Types.Module +[GblId, + Caf=NoCafRefs, + Str=m, + Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 30}] +Foo.$trModule = GHC.Types.Module Foo.$trModule3 Foo.$trModule1 + +-- RHS size: {terms: 3, types: 1, coercions: 0, joins: 0/0} +$krep_r2oJ :: GHC.Types.KindRep +[GblId, Caf=NoCafRefs, Str=m1, Unf=OtherCon []] +$krep_r2oJ = GHC.Types.KindRepTyConApp GHC.Types.$tcInt (GHC.Types.[] @ GHC.Types.KindRep) + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +$krep1_r2oK :: GHC.Types.KindRep +[GblId, Caf=NoCafRefs, Str=m2, Unf=OtherCon []] +$krep1_r2oK = GHC.Types.KindRepVar 0# + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +Foo.$tcT5 :: GHC.Prim.Addr# +[GblId, + Caf=NoCafRefs, + Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}] +Foo.$tcT5 = "T2"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +Foo.$tcT1 :: GHC.Types.TrName +[GblId, + Caf=NoCafRefs, + Str=m1, + Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 20}] +Foo.$tcT1 = GHC.Types.TrNameS Foo.$tcT5 + +-- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} +Foo.$tcT2 :: GHC.Types.TyCon +[GblId, + Caf=NoCafRefs, + Str=m, + Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 70}] +Foo.$tcT2 = GHC.Types.TyCon 12492463661685256209## 1082997131366389398## Foo.$trModule Foo.$tcT1 0# GHC.Types.krep$* + +-- RHS size: {terms: 3, types: 1, coercions: 0, joins: 0/0} +$krep2_r2oL :: GHC.Types.KindRep +[GblId, Caf=NoCafRefs, Str=m1, Unf=OtherCon []] +$krep2_r2oL = GHC.Types.KindRepTyConApp Foo.$tcT2 (GHC.Types.[] @ GHC.Types.KindRep) + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +$krep3_r2oM :: GHC.Types.KindRep +[GblId, Caf=NoCafRefs, Str=m4, Unf=OtherCon []] +$krep3_r2oM = GHC.Types.KindRepFun $krep_r2oJ $krep2_r2oL + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +Foo.$tc'MkT1 [InlPrag=NOUSERINLINE[~]] :: GHC.Types.KindRep +[GblId, Caf=NoCafRefs, Str=m4, Unf=OtherCon []] +Foo.$tc'MkT1 = GHC.Types.KindRepFun $krep_r2oJ $krep3_r2oM + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +Foo.$tc'MkT6 :: GHC.Prim.Addr# +[GblId, + Caf=NoCafRefs, + Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 0}] +Foo.$tc'MkT6 = "'MkT2"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +Foo.$tc'MkT5 :: GHC.Types.TrName +[GblId, + Caf=NoCafRefs, + Str=m1, + Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 20}] +Foo.$tc'MkT5 = GHC.Types.TrNameS Foo.$tc'MkT6 + +-- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} +Foo.$tc'MkT2 :: GHC.Types.TyCon +[GblId, + Caf=NoCafRefs, + Str=m, + Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 70}] +Foo.$tc'MkT2 = GHC.Types.TyCon 5707542518475997625## 9584804394183763875## Foo.$trModule Foo.$tc'MkT5 0# Foo.$tc'MkT1 + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +Foo.$tcT7 :: GHC.Prim.Addr# +[GblId, + Caf=NoCafRefs, + Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}] +Foo.$tcT7 = "T3"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +Foo.$tcT6 :: GHC.Types.TrName +[GblId, + Caf=NoCafRefs, + Str=m1, + Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 20}] +Foo.$tcT6 = GHC.Types.TrNameS Foo.$tcT7 + +-- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} +Foo.$tcT3 :: GHC.Types.TyCon +[GblId, + Caf=NoCafRefs, + Str=m, + Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 70}] +Foo.$tcT3 = GHC.Types.TyCon 8915518733037212359## 16476420519216613869## Foo.$trModule Foo.$tcT6 0# GHC.Types.krep$* + +-- RHS size: {terms: 3, types: 1, coercions: 0, joins: 0/0} +$krep4_r2oN :: GHC.Types.KindRep +[GblId, Caf=NoCafRefs, Str=m1, Unf=OtherCon []] +$krep4_r2oN = GHC.Types.KindRepTyConApp Foo.$tcT3 (GHC.Types.[] @ GHC.Types.KindRep) + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +$krep5_r2oO :: GHC.Types.KindRep +[GblId, Caf=NoCafRefs, Str=m4, Unf=OtherCon []] +$krep5_r2oO = GHC.Types.KindRepFun $krep_r2oJ $krep4_r2oN + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +Foo.$tc'MkT7 [InlPrag=NOUSERINLINE[~]] :: GHC.Types.KindRep +[GblId, Caf=NoCafRefs, Str=m4, Unf=OtherCon []] +Foo.$tc'MkT7 = GHC.Types.KindRepFun $krep_r2oJ $krep5_r2oO + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +Foo.$tc'MkT9 :: GHC.Prim.Addr# +[GblId, + Caf=NoCafRefs, + Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 0}] +Foo.$tc'MkT9 = "'MkT3"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +Foo.$tc'MkT8 :: GHC.Types.TrName +[GblId, + Caf=NoCafRefs, + Str=m1, + Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 20}] +Foo.$tc'MkT8 = GHC.Types.TrNameS Foo.$tc'MkT9 + +-- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} +Foo.$tc'MkT3 :: GHC.Types.TyCon +[GblId, + Caf=NoCafRefs, + Str=m, + Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 70}] +Foo.$tc'MkT3 = GHC.Types.TyCon 7218783144619306039## 13236146459150723629## Foo.$trModule Foo.$tc'MkT8 0# Foo.$tc'MkT7 + +-- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} +Foo.$tcFoo :: GHC.Types.TyCon +[GblId, + Caf=NoCafRefs, + Str=m, + Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 70}] +Foo.$tcFoo = GHC.Types.TyCon 11236787750777559483## 2472662601374496863## Foo.$trModule Foo.$trModule1 0# GHC.Types.krep$*Arr* + +-- RHS size: {terms: 3, types: 2, coercions: 0, joins: 0/0} +$krep6_r2oP :: [GHC.Types.KindRep] +[GblId, Caf=NoCafRefs, Str=m2, Unf=OtherCon []] +$krep6_r2oP = GHC.Types.: @ GHC.Types.KindRep $krep1_r2oK (GHC.Types.[] @ GHC.Types.KindRep) + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +$krep7_r2oQ :: GHC.Types.KindRep +[GblId, Caf=NoCafRefs, Str=m1, Unf=OtherCon []] +$krep7_r2oQ = GHC.Types.KindRepTyConApp Foo.$tcFoo $krep6_r2oP + +-- RHS size: {terms: 3, types: 2, coercions: 0, joins: 0/0} +$krep8_r2oR :: [GHC.Types.KindRep] +[GblId, Caf=NoCafRefs, Str=m2, Unf=OtherCon []] +$krep8_r2oR = GHC.Types.: @ GHC.Types.KindRep $krep_r2oJ (GHC.Types.[] @ GHC.Types.KindRep) + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +$krep9_r2oS :: GHC.Types.KindRep +[GblId, Caf=NoCafRefs, Str=m1, Unf=OtherCon []] +$krep9_r2oS = GHC.Types.KindRepTyConApp Foo.$tcFoo $krep8_r2oR + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +Foo.$tc'Foo1 [InlPrag=NOUSERINLINE[~]] :: GHC.Types.KindRep +[GblId, Caf=NoCafRefs, Str=m4, Unf=OtherCon []] +Foo.$tc'Foo1 = GHC.Types.KindRepFun $krep_r2oJ $krep9_r2oS + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +Foo.$tc'Foo3 :: GHC.Prim.Addr# +[GblId, + Caf=NoCafRefs, + Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}] +Foo.$tc'Foo3 = "'Foo"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +Foo.$tc'Foo2 :: GHC.Types.TrName +[GblId, + Caf=NoCafRefs, + Str=m1, + Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 20}] +Foo.$tc'Foo2 = GHC.Types.TrNameS Foo.$tc'Foo3 + +-- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} +Foo.$tc'Foo :: GHC.Types.TyCon +[GblId, + Caf=NoCafRefs, + Str=m, + Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 70}] +Foo.$tc'Foo = GHC.Types.TyCon 10641757595611461765## 13961773224584044648## Foo.$trModule Foo.$tc'Foo2 0# Foo.$tc'Foo1 + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +Foo.$tcT9 :: GHC.Prim.Addr# +[GblId, + Caf=NoCafRefs, + Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}] +Foo.$tcT9 = "T4"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +Foo.$tcT8 :: GHC.Types.TrName +[GblId, + Caf=NoCafRefs, + Str=m1, + Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 20}] +Foo.$tcT8 = GHC.Types.TrNameS Foo.$tcT9 + +-- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} +Foo.$tcT4 :: GHC.Types.TyCon +[GblId, + Caf=NoCafRefs, + Str=m, + Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 70}] +Foo.$tcT4 = GHC.Types.TyCon 15961711399118996930## 13694522307176382499## Foo.$trModule Foo.$tcT8 0# GHC.Types.krep$*Arr* + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +$krep10_r2oT :: GHC.Types.KindRep +[GblId, Caf=NoCafRefs, Str=m1, Unf=OtherCon []] +$krep10_r2oT = GHC.Types.KindRepTyConApp Foo.$tcT4 $krep6_r2oP + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +$krep11_r2oU :: GHC.Types.KindRep +[GblId, Caf=NoCafRefs, Str=m4, Unf=OtherCon []] +$krep11_r2oU = GHC.Types.KindRepFun $krep_r2oJ $krep10_r2oT + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +Foo.$tc'MkT10 [InlPrag=NOUSERINLINE[~]] :: GHC.Types.KindRep +[GblId, Caf=NoCafRefs, Str=m4, Unf=OtherCon []] +Foo.$tc'MkT10 = GHC.Types.KindRepFun $krep7_r2oQ $krep11_r2oU + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +Foo.$tc'MkT12 :: GHC.Prim.Addr# +[GblId, + Caf=NoCafRefs, + Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 0}] +Foo.$tc'MkT12 = "'MkT4"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +Foo.$tc'MkT11 :: GHC.Types.TrName +[GblId, + Caf=NoCafRefs, + Str=m1, + Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 20}] +Foo.$tc'MkT11 = GHC.Types.TrNameS Foo.$tc'MkT12 + +-- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} +Foo.$tc'MkT4 :: GHC.Types.TyCon +[GblId, + Caf=NoCafRefs, + Str=m, + Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 70}] +Foo.$tc'MkT4 = GHC.Types.TyCon 6077781708614236332## 14823286043222481570## Foo.$trModule Foo.$tc'MkT11 1# Foo.$tc'MkT10 + +Rec { +-- RHS size: {terms: 14, types: 3, coercions: 0, joins: 0/0} +Foo.$wf4 [InlPrag=NOUSERINLINE[2], Occ=LoopBreaker] :: GHC.Prim.Int# -> GHC.Prim.Int# -> GHC.Prim.Int# +[GblId, Arity=2, Caf=NoCafRefs, Str=<S,1*U><S,U>, Unf=OtherCon []] +Foo.$wf4 + = \ (ww_s2jL :: GHC.Prim.Int#) (ww1_s2jQ :: GHC.Prim.Int#) -> + case GHC.Prim.># ww1_s2jQ 0# of { + __DEFAULT -> ww_s2jL; + 1# -> Foo.$wf4 ww_s2jL (GHC.Prim.-# ww1_s2jQ 1#) + } +end Rec } + +-- RHS size: {terms: 17, types: 12, coercions: 3, joins: 0/0} +f4 [InlPrag=NOUSERINLINE[2]] :: T4 Int -> Int +[GblId, + Arity=1, + Caf=NoCafRefs, + Str=<S(S(S)S(S)),1*U(U(1*U),1*U(U))>m, + Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, + Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=False) + Tmpl= \ (w_s2jF [Occ=Once!] :: T4 Int) -> + case w_s2jF of { MkT4 ww1_s2jI [Occ=Once] ww2_s2jN [Occ=Once!] -> + case ww1_s2jI `cast` (Foo.D:R:FooInt0[0] ; Foo.N:R:FooInt[0] :: (Foo Int :: *) ~R# (Int :: *)) of + { GHC.Types.I# ww4_s2jL [Occ=Once] -> + case ww2_s2jN of { GHC.Types.I# ww6_s2jQ [Occ=Once] -> + case Foo.$wf4 ww4_s2jL ww6_s2jQ of ww7_s2jV { __DEFAULT -> GHC.Types.I# ww7_s2jV } + } + } + }}] +f4 + = \ (w_s2jF :: T4 Int) -> + case w_s2jF of { MkT4 ww1_s2jI ww2_s2jN -> + case ww1_s2jI `cast` (Foo.D:R:FooInt0[0] ; Foo.N:R:FooInt[0] :: (Foo Int :: *) ~R# (Int :: *)) of { GHC.Types.I# ww4_s2mW -> + case ww2_s2jN of { GHC.Types.I# ww6_s2jQ -> case Foo.$wf4 ww4_s2mW ww6_s2jQ of ww7_s2jV { __DEFAULT -> GHC.Types.I# ww7_s2jV } } + } + } + +Rec { +-- RHS size: {terms: 21, types: 4, coercions: 0, joins: 0/0} +Foo.$wf2 [InlPrag=NOUSERINLINE[2], Occ=LoopBreaker] :: GHC.Prim.Int# -> GHC.Prim.Int# -> GHC.Prim.Int# +[GblId, Arity=2, Caf=NoCafRefs, Str=<L,1*U><S,U>, Unf=OtherCon []] +Foo.$wf2 + = \ (ww_s2k3 :: GHC.Prim.Int#) (ww1_s2k8 :: GHC.Prim.Int#) -> + case GHC.Prim.># ww1_s2k8 0# of { + __DEFAULT -> + case GHC.Prim.># ww1_s2k8 1# of { + __DEFAULT -> ww_s2k3; + 1# -> 1# + }; + 1# -> Foo.$wf2 ww_s2k3 (GHC.Prim.-# ww1_s2k8 1#) + } +end Rec } + +-- RHS size: {terms: 17, types: 9, coercions: 0, joins: 0/0} +f2 [InlPrag=NOUSERINLINE[2]] :: T2 -> Int +[GblId, + Arity=1, + Caf=NoCafRefs, + Str=<S(S(S)S(S)),1*U(U(1*U),1*U(U))>m, + Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, + Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=False) + Tmpl= \ (w_s2jX [Occ=Once!] :: T2) -> + case w_s2jX of { MkT2 ww1_s2k0 [Occ=Once!] ww2_s2k5 [Occ=Once!] -> + case ww1_s2k0 of { GHC.Types.I# ww4_s2k3 [Occ=Once] -> + case ww2_s2k5 of { GHC.Types.I# ww6_s2k8 [Occ=Once] -> + case Foo.$wf2 ww4_s2k3 ww6_s2k8 of ww7_s2kd { __DEFAULT -> GHC.Types.I# ww7_s2kd } + } + } + }}] +f2 + = \ (w_s2jX :: T2) -> + case w_s2jX of { MkT2 ww1_s2k0 ww2_s2k5 -> + case ww1_s2k0 of { GHC.Types.I# ww4_s2mZ -> + case ww2_s2k5 of { GHC.Types.I# ww6_s2k8 -> case Foo.$wf2 ww4_s2mZ ww6_s2k8 of ww7_s2kd { __DEFAULT -> GHC.Types.I# ww7_s2kd } } + } + } + +Rec { +-- RHS size: {terms: 15, types: 4, coercions: 0, joins: 0/0} +Foo.$wh [InlPrag=NOUSERINLINE[2], Occ=LoopBreaker] :: GHC.Prim.Int# -> GHC.Prim.Int# -> Bool +[GblId, Arity=2, Caf=NoCafRefs, Str=<S,1*U><S,U>, Unf=OtherCon []] +Foo.$wh + = \ (ww_s2kj :: GHC.Prim.Int#) (ww1_s2kn :: GHC.Prim.Int#) -> + case ww_s2kj of ds_X2gt { + __DEFAULT -> Foo.$wh (GHC.Prim.-# ds_X2gt 1#) ww1_s2kn; + 0# -> GHC.Prim.tagToEnum# @ Bool (GHC.Prim.># ww1_s2kn 0#) + } +end Rec } + +-- RHS size: {terms: 11, types: 6, coercions: 0, joins: 0/0} +h [InlPrag=NOUSERINLINE[2]] :: Int -> Int -> Bool +[GblId, + Arity=2, + Caf=NoCafRefs, + Str=<S(S),1*U(1*U)><S(S),1*U(U)>, + Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, + Guidance=ALWAYS_IF(arity=2,unsat_ok=True,boring_ok=False) + Tmpl= \ (w_s2kf [Occ=Once!] :: Int) (w1_s2kg [Occ=Once!] :: Int) -> + case w_s2kf of { GHC.Types.I# ww1_s2kj [Occ=Once] -> + case w1_s2kg of { GHC.Types.I# ww3_s2kn [Occ=Once] -> Foo.$wh ww1_s2kj ww3_s2kn } + }}] +h = \ (w_s2kf :: Int) (w1_s2kg :: Int) -> + case w_s2kf of { GHC.Types.I# ww1_s2kj -> case w1_s2kg of { GHC.Types.I# ww3_s2kn -> Foo.$wh ww1_s2kj ww3_s2kn } } + +Rec { +-- RHS size: {terms: 12, types: 2, coercions: 0, joins: 0/0} +Foo.$wf1 [InlPrag=NOUSERINLINE[2], Occ=LoopBreaker] :: GHC.Prim.Int# -> GHC.Prim.Int# +[GblId, Arity=1, Caf=NoCafRefs, Str=<S,U>, Unf=OtherCon []] +Foo.$wf1 + = \ (ww_s2kt :: GHC.Prim.Int#) -> + case Foo.$wh ww_s2kt ww_s2kt of { + False -> Foo.$wf1 (GHC.Prim.-# ww_s2kt 1#); + True -> ww_s2kt + } +end Rec } + +-- RHS size: {terms: 10, types: 4, coercions: 0, joins: 0/0} +f1 [InlPrag=NOUSERINLINE[2]] :: Int -> Int +[GblId, + Arity=1, + Caf=NoCafRefs, + Str=<S(S),1*U(U)>m, + Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, + Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=False) + Tmpl= \ (w_s2kq [Occ=Once!] :: Int) -> + case w_s2kq of { GHC.Types.I# ww1_s2kt [Occ=Once] -> case Foo.$wf1 ww1_s2kt of ww2_s2kx { __DEFAULT -> GHC.Types.I# ww2_s2kx } }}] +f1 + = \ (w_s2kq :: Int) -> + case w_s2kq of { GHC.Types.I# ww1_s2kt -> case Foo.$wf1 ww1_s2kt of ww2_s2kx { __DEFAULT -> GHC.Types.I# ww2_s2kx } } + +Rec { +-- RHS size: {terms: 14, types: 3, coercions: 0, joins: 0/0} +Foo.$wf3 [InlPrag=NOUSERINLINE[2], Occ=LoopBreaker] :: GHC.Prim.Int# -> GHC.Prim.Int# -> GHC.Prim.Int# +[GblId, Arity=2, Caf=NoCafRefs, Str=<S,U><S,U>, Unf=OtherCon []] +Foo.$wf3 + = \ (ww_s2kF :: GHC.Prim.Int#) (ww1_s2kK :: GHC.Prim.Int#) -> + case Foo.$wh ww_s2kF ww1_s2kK of { + False -> ww_s2kF; + True -> Foo.$wf3 ww_s2kF (GHC.Prim.-# ww1_s2kK 1#) + } +end Rec } + +-- RHS size: {terms: 17, types: 9, coercions: 0, joins: 0/0} +f3 [InlPrag=NOUSERINLINE[2]] :: T3 -> Int +[GblId, + Arity=1, + Caf=NoCafRefs, + Str=<S(S(S)S(S)),1*U(1*U(U),1*U(U))>m, + Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, + Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=False) + Tmpl= \ (w_s2kz [Occ=Once!] :: T3) -> + case w_s2kz of { MkT3 ww1_s2kC [Occ=Once!] ww2_s2kH [Occ=Once!] -> + case ww1_s2kC of { GHC.Types.I# ww4_s2kF [Occ=Once] -> + case ww2_s2kH of { GHC.Types.I# ww6_s2kK [Occ=Once] -> + case Foo.$wf3 ww4_s2kF ww6_s2kK of ww7_s2kP { __DEFAULT -> GHC.Types.I# ww7_s2kP } + } + } + }}] +f3 + = \ (w_s2kz :: T3) -> + case w_s2kz of { MkT3 ww1_s2kC ww2_s2kH -> + case ww1_s2kC of { GHC.Types.I# ww4_s2kF -> + case ww2_s2kH of { GHC.Types.I# ww6_s2kK -> case Foo.$wf3 ww4_s2kF ww6_s2kK of ww7_s2kP { __DEFAULT -> GHC.Types.I# ww7_s2kP } } + } + } + + + diff --git a/testsuite/tests/stranal/should_compile/T10694.stderr b/testsuite/tests/stranal/should_compile/T10694.stderr index e021eb37df..90ab9475f2 100644 --- a/testsuite/tests/stranal/should_compile/T10694.stderr +++ b/testsuite/tests/stranal/should_compile/T10694.stderr @@ -1,75 +1,91 @@ ==================== Tidy Core ==================== -Result size of Tidy Core = {terms: 70, types: 63, coercions: 0} +Result size of Tidy Core = {terms: 74, types: 65, coercions: 0, joins: 0/4} --- RHS size: {terms: 39, types: 25, coercions: 0} +-- RHS size: {terms: 39, types: 25, coercions: 0, joins: 0/4} T10694.$wpm [InlPrag=NOINLINE] :: Int -> Int -> (# Int, Int #) -[GblId, Arity=2, Str=<L,U(U)><L,U(U)>] -T10694.$wpm = - \ (w_sVU :: Int) (w1_sVV :: Int) -> - let { - l_sUQ :: Int - [LclId] - l_sUQ = case w_sVU of { GHC.Types.I# x_aUi -> case w1_sVV of { GHC.Types.I# y_aUm -> GHC.Types.I# (GHC.Prim.+# x_aUi y_aUm) } } } in - let { - l1_sUS :: Int - [LclId] - l1_sUS = case w_sVU of { GHC.Types.I# x_aUs -> case w1_sVV of { GHC.Types.I# y_aUw -> GHC.Types.I# (GHC.Prim.-# x_aUs y_aUw) } } } in - let { - l2_sUR :: [Int] - [LclId, Unf=OtherCon []] - l2_sUR = GHC.Types.: @ Int l1_sUS (GHC.Types.[] @ Int) } in - let { - l3_sUH :: [Int] - [LclId, Unf=OtherCon []] - l3_sUH = GHC.Types.: @ Int l_sUQ l2_sUR } in - (# GHC.List.$w!! @ Int l3_sUH 0#, GHC.List.$w!! @ Int l3_sUH 1# #) +[GblId, Arity=2, Str=<L,U(U)><L,U(U)>, Unf=OtherCon []] +T10694.$wpm + = \ (w_s1v7 :: Int) (w1_s1v8 :: Int) -> + let { + l_s1u8 :: Int + [LclId] + l_s1u8 + = case w_s1v7 of { GHC.Types.I# x_a1ty -> case w1_s1v8 of { GHC.Types.I# y_a1tC -> GHC.Types.I# (GHC.Prim.+# x_a1ty y_a1tC) } } } in + let { + l1_s1u9 :: Int + [LclId] + l1_s1u9 + = case w_s1v7 of { GHC.Types.I# x_a1tI -> case w1_s1v8 of { GHC.Types.I# y_a1tM -> GHC.Types.I# (GHC.Prim.-# x_a1tI y_a1tM) } } } in + let { + l2_s1ua :: [Int] + [LclId, Unf=OtherCon []] + l2_s1ua = GHC.Types.: @ Int l1_s1u9 (GHC.Types.[] @ Int) } in + let { + l3_s1tZ :: [Int] + [LclId, Unf=OtherCon []] + l3_s1tZ = GHC.Types.: @ Int l_s1u8 l2_s1ua } in + (# GHC.List.$w!! @ Int l3_s1tZ 0#, GHC.List.$w!! @ Int l3_s1tZ 1# #) --- RHS size: {terms: 10, types: 11, coercions: 0} -pm [InlPrag=INLINE[0]] :: Int -> Int -> (Int, Int) +-- RHS size: {terms: 10, types: 11, coercions: 0, joins: 0/0} +pm [InlPrag=NOUSERINLINE[0]] :: Int -> Int -> (Int, Int) [GblId, Arity=2, Str=<L,U(U)><L,U(U)>m, Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=ALWAYS_IF(arity=2,unsat_ok=True,boring_ok=False) - Tmpl= \ (w_sVU [Occ=Once] :: Int) (w1_sVV [Occ=Once] :: Int) -> - case T10694.$wpm w_sVU w1_sVV of { (# ww1_sW0 [Occ=Once], ww2_sW1 [Occ=Once] #) -> (ww1_sW0, ww2_sW1) }}] -pm = \ (w_sVU :: Int) (w1_sVV :: Int) -> case T10694.$wpm w_sVU w1_sVV of { (# ww1_sW0, ww2_sW1 #) -> (ww1_sW0, ww2_sW1) } + Tmpl= \ (w_s1v7 [Occ=Once] :: Int) (w1_s1v8 [Occ=Once] :: Int) -> + case T10694.$wpm w_s1v7 w1_s1v8 of { (# ww1_s1vd [Occ=Once], ww2_s1ve [Occ=Once] #) -> (ww1_s1vd, ww2_s1ve) }}] +pm = \ (w_s1v7 :: Int) (w1_s1v8 :: Int) -> case T10694.$wpm w_s1v7 w1_s1v8 of { (# ww1_s1vd, ww2_s1ve #) -> (ww1_s1vd, ww2_s1ve) } --- RHS size: {terms: 8, types: 9, coercions: 0} +-- RHS size: {terms: 8, types: 9, coercions: 0, joins: 0/0} m :: Int -> Int -> Int [GblId, Arity=2, Str=<L,U(U)><L,U(U)>, Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=ALWAYS_IF(arity=2,unsat_ok=True,boring_ok=False) - Tmpl= \ (x_aCT [Occ=Once] :: Int) (y_aCU [Occ=Once] :: Int) -> - case pm x_aCT y_aCU of { (_ [Occ=Dead], mr_aCW [Occ=Once]) -> mr_aCW }}] -m = \ (x_aCT :: Int) (y_aCU :: Int) -> case T10694.$wpm x_aCT y_aCU of { (# ww1_sW0, ww2_sW1 #) -> ww2_sW1 } + Tmpl= \ (x_a12s [Occ=Once] :: Int) (y_a12t [Occ=Once] :: Int) -> + case pm x_a12s y_a12t of { (_ [Occ=Dead], mr_a12v [Occ=Once]) -> mr_a12v }}] +m = \ (x_a12s :: Int) (y_a12t :: Int) -> case T10694.$wpm x_a12s y_a12t of { (# ww1_s1vd, ww2_s1ve #) -> ww2_s1ve } --- RHS size: {terms: 2, types: 0, coercions: 0} -T10694.$trModule2 :: GHC.Types.TrName +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +T10694.$trModule4 :: GHC.Prim.Addr# +[GblId, + Caf=NoCafRefs, + Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}] +T10694.$trModule4 = "main"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +T10694.$trModule3 :: GHC.Types.TrName [GblId, Caf=NoCafRefs, Str=m1, - Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 20}] -T10694.$trModule2 = GHC.Types.TrNameS "main"# + Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 20}] +T10694.$trModule3 = GHC.Types.TrNameS T10694.$trModule4 + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +T10694.$trModule2 :: GHC.Prim.Addr# +[GblId, + Caf=NoCafRefs, + Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 0}] +T10694.$trModule2 = "T10694"# --- RHS size: {terms: 2, types: 0, coercions: 0} +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} T10694.$trModule1 :: GHC.Types.TrName [GblId, Caf=NoCafRefs, Str=m1, - Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 40 20}] -T10694.$trModule1 = GHC.Types.TrNameS "T10694"# + Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 20}] +T10694.$trModule1 = GHC.Types.TrNameS T10694.$trModule2 --- RHS size: {terms: 3, types: 0, coercions: 0} +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} T10694.$trModule :: GHC.Types.Module [GblId, Caf=NoCafRefs, Str=m, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 30}] -T10694.$trModule = GHC.Types.Module T10694.$trModule2 T10694.$trModule1 +T10694.$trModule = GHC.Types.Module T10694.$trModule3 T10694.$trModule1 diff --git a/testsuite/tests/stranal/should_compile/T9208.hs b/testsuite/tests/stranal/should_compile/T9208.hs index b8ec6df6d1..5243445c96 100644 --- a/testsuite/tests/stranal/should_compile/T9208.hs +++ b/testsuite/tests/stranal/should_compile/T9208.hs @@ -25,6 +25,7 @@ import Control.Monad #if __GLASGOW_HASKELL__ >= 800 import Control.Monad.Fail (MonadFail(fail)) #endif +import Control.Monad.IO.Class (MonadIO (..)) import Data.Binary import Data.Binary.Get @@ -81,7 +82,8 @@ instance MonadFail GHCJSQ where fail = undefined #endif -instance TH.Quasi GHCJSQ where qRunIO m = GHCJSQ $ \s -> fmap (,s) m +instance MonadIO GHCJSQ where liftIO m = GHCJSQ $ \s -> fmap (,s) m +instance TH.Quasi GHCJSQ -- | the Template Haskell server runTHServer :: IO () diff --git a/testsuite/tests/stranal/should_compile/all.T b/testsuite/tests/stranal/should_compile/all.T index d8fc7575cd..4421b24a6e 100644 --- a/testsuite/tests/stranal/should_compile/all.T +++ b/testsuite/tests/stranal/should_compile/all.T @@ -1,19 +1,6 @@ # Only compile with optimisation setTestOpts( only_ways(['optasm']) ) -def checkCoreString(needle): - def norm(str): - if needle in str: - return "%s contained in -ddump-simpl\n" % needle - else: - return "%s not contained in -ddump-simpl\n" % needle - return normalise_errmsg_fun(norm) - -def grepCoreString(needle): - def norm(str): - return "".join(filter(lambda l: re.search(needle, l), str.splitlines(True))) - return normalise_errmsg_fun(norm) - test('default', normal, compile, ['']) test('fact', normal, compile, ['']) test('fun', normal, compile, ['']) @@ -39,15 +26,15 @@ test('T8743', [], multimod_compile, ['T8743', '-v0']) # with two unboxed args. See Trac #10482 for background # # Set -dppr-cols to ensure output doesn't wrap -test('T10482', [ grepCoreString(r'wfoo.*Int#') ], compile, ['-dppr-cols=200 -ddump-simpl']) -test('T10482a', [ grepCoreString(r'wf.*Int#') ], compile, ['-dppr-cols=200 -ddump-simpl']) +test('T10482', [ grep_errmsg(r'wfoo.*Int#') ], compile, ['-dppr-cols=200 -ddump-simpl']) +test('T10482a', [ grep_errmsg(r'wf.*Int#') ], compile, ['-dppr-cols=200 -ddump-simpl']) test('T9208', when(compiler_debugged(), expect_broken(9208)), compile, ['']) # T9208 fails (and should do so) if you have assertion checking on in the compiler # Hence the above expect_broken. See comments in the Trac ticket -test('T10694', [ grepCoreString(r'Str=') ], compile, ['-dppr-cols=200 -ddump-simpl']) -test('T11770', [ checkCoreString('OneShot') ], compile, ['-ddump-simpl']) +test('T10694', [ grep_errmsg(r'Str=') ], compile, ['-dppr-cols=200 -ddump-simpl']) +test('T11770', [ check_errmsg('OneShot') ], compile, ['-ddump-simpl']) test('T13031', normal, run_command, ['$MAKE -s --no-print-directory T13031']) diff --git a/testsuite/tests/stranal/should_run/T14285.hs b/testsuite/tests/stranal/should_run/T14285.hs new file mode 100644 index 0000000000..29da51e734 --- /dev/null +++ b/testsuite/tests/stranal/should_run/T14285.hs @@ -0,0 +1,9 @@ +module Main where + +import T14285a +import Prelude hiding (null) + +main :: IO () +main = do + let args = "hw" + print $ null $ pre_images 'a' (Rel (fromList [('a',sfromList args)]) (fromList [('b',sfromList args)])) diff --git a/testsuite/tests/stranal/should_run/T14285.stdout b/testsuite/tests/stranal/should_run/T14285.stdout new file mode 100644 index 0000000000..0ca95142bb --- /dev/null +++ b/testsuite/tests/stranal/should_run/T14285.stdout @@ -0,0 +1 @@ +True diff --git a/testsuite/tests/stranal/should_run/T14285a.hs b/testsuite/tests/stranal/should_run/T14285a.hs new file mode 100644 index 0000000000..8ee9b38df6 --- /dev/null +++ b/testsuite/tests/stranal/should_run/T14285a.hs @@ -0,0 +1,37 @@ +module T14285a where + +import qualified Data.Foldable as F +import qualified Data.IntMap as IM +import qualified Data.IntSet as IS +import Prelude hiding (null) + +data Set k = Set IS.IntSet + +empty = Set IS.empty + + +null (Set a) = IS.null a + +sfromList :: (Enum a, Foldable c) => c a -> Set a +sfromList xs = Set $ IS.fromList $ Prelude.map fromEnum $ F.toList xs + +{-# inlineable fromList #-} +fromList :: Enum k => [(k,v)] -> Map k v +fromList kvs = + Map $ IM.fromList $ Prelude.map (\(k,v) -> (fromEnum k, v)) kvs + + +newtype Map k v = Map { unMap :: (IM.IntMap v) } deriving (Eq, Ord) + +{-# inlineable findWithDefault #-} +findWithDefault d k (Map m) = IM.findWithDefault d (fromEnum k) m + +data Rel a b = Rel !(Map a (Set b)) !(Map b (Set a)) + +{-# INLINEABLE images #-} +images x (Rel f b) = findWithDefault empty x f +{-# INLINEABLE pre_images #-} +pre_images x rel = images x $ mirrorRel rel +{-# INLINEABLE mirrorRel #-} +mirrorRel :: Rel a b -> Rel b a +mirrorRel (Rel f g) = Rel g f diff --git a/testsuite/tests/stranal/should_run/T14290.hs b/testsuite/tests/stranal/should_run/T14290.hs new file mode 100644 index 0000000000..7093239d4c --- /dev/null +++ b/testsuite/tests/stranal/should_run/T14290.hs @@ -0,0 +1,17 @@ +{-# LANGUAGE ExistentialQuantification #-} +module Main (main) where + +main :: IO () +main = r `seq` return () + +r :: Rec +r = Rec{ a = error "xxx", b = 3, c = True } + +class C t +instance C Bool + +data Rec = forall t. C t => Rec + { a :: () + , b :: !Int + , c :: t + } diff --git a/testsuite/tests/stranal/should_run/all.T b/testsuite/tests/stranal/should_run/all.T index 076474608e..a9cc3d7071 100644 --- a/testsuite/tests/stranal/should_run/all.T +++ b/testsuite/tests/stranal/should_run/all.T @@ -15,3 +15,5 @@ test('T11555a', normal, compile_and_run, ['']) test('T12368', exit_code(1), compile_and_run, ['']) test('T12368a', exit_code(1), compile_and_run, ['']) test('T13380', [expect_broken(13380), exit_code(1)], compile_and_run, ['']) +test('T14290', normal, compile_and_run, ['']) +test('T14285', normal, multimod_compile_and_run, ['T14285', '']) diff --git a/testsuite/tests/stranal/sigs/CaseBinderCPR.hs b/testsuite/tests/stranal/sigs/CaseBinderCPR.hs new file mode 100644 index 0000000000..13f216347d --- /dev/null +++ b/testsuite/tests/stranal/sigs/CaseBinderCPR.hs @@ -0,0 +1,15 @@ +module CaseBinderCPR where + +-- This example, taken from nofib's transform (and heavily reduced) ensures that +-- CPR information is added to a case binder + +f_list_cmp::(t1 -> t1 -> Int) -> [t1] -> [t1] -> Int; +f_list_cmp a_cmp [] []= 0 +f_list_cmp a_cmp [] a_ys= -1 +f_list_cmp a_cmp a_xs []= 1 +f_list_cmp a_cmp (a_x:a_xs) (a_y:a_ys)= + if r_order == 0 + then f_list_cmp a_cmp a_xs a_ys + else r_order + where + r_order = a_cmp a_x a_y diff --git a/testsuite/tests/stranal/sigs/CaseBinderCPR.stderr b/testsuite/tests/stranal/sigs/CaseBinderCPR.stderr new file mode 100644 index 0000000000..f708813a81 --- /dev/null +++ b/testsuite/tests/stranal/sigs/CaseBinderCPR.stderr @@ -0,0 +1,12 @@ + +==================== Strictness signatures ==================== +CaseBinderCPR.$trModule: m +CaseBinderCPR.f_list_cmp: <L,C(C1(U(U)))><S,1*U><S,1*U>m + + + +==================== Strictness signatures ==================== +CaseBinderCPR.$trModule: m +CaseBinderCPR.f_list_cmp: <L,C(C1(U(1*U)))><S,1*U><S,1*U>m + + diff --git a/testsuite/tests/stranal/sigs/all.T b/testsuite/tests/stranal/sigs/all.T index f28cda7b89..091a4f47ee 100644 --- a/testsuite/tests/stranal/sigs/all.T +++ b/testsuite/tests/stranal/sigs/all.T @@ -16,3 +16,4 @@ test('UnsatFun', normal, compile, ['']) test('BottomFromInnerLambda', normal, compile, ['']) test('DmdAnalGADTs', normal, compile, ['']) test('T12370', normal, compile, ['']) +test('CaseBinderCPR', normal, compile, ['']) diff --git a/testsuite/tests/th/ClosedFam1TH.stderr b/testsuite/tests/th/ClosedFam1TH.stderr index 8855da204f..8db375413a 100644 --- a/testsuite/tests/th/ClosedFam1TH.stderr +++ b/testsuite/tests/th/ClosedFam1TH.stderr @@ -1,6 +1,6 @@ -ClosedFam1TH.hs:7:3: Warning: +ClosedFam1TH.hs:7:3: warning: type family Foo_0 a_1 (b_2 :: k_3) where Foo_0 GHC.Types.Int GHC.Types.Bool = GHC.Types.Int - Foo_0 a_4 GHC.Base.Maybe = GHC.Types.Bool + Foo_0 a_4 GHC.Maybe.Maybe = GHC.Types.Bool Foo_0 b_5 (x_6 :: GHC.Types.Bool) = GHC.Types.Char diff --git a/testsuite/tests/th/T10267.stderr b/testsuite/tests/th/T10267.stderr index e255178839..71aca96b86 100644 --- a/testsuite/tests/th/T10267.stderr +++ b/testsuite/tests/th/T10267.stderr @@ -10,6 +10,7 @@ T10267.hs:8:1: error: • Relevant bindings include x :: a (bound at T10267.hs:8:1) j :: a -> a (bound at T10267.hs:8:1) + Valid hole fits include x :: a (bound at T10267.hs:8:1) T10267.hs:8:1: error: • Found hole: _foo :: a -> a @@ -21,6 +22,24 @@ T10267.hs:8:1: error: • In the expression: _foo In an equation for ‘i’: i = _foo • Relevant bindings include i :: a -> a (bound at T10267.hs:8:1) + Valid hole fits include + i :: a -> a (bound at T10267.hs:8:1) + j :: forall a0. a0 -> a0 + with j @a + (bound at T10267.hs:8:1) + k :: forall a. a -> a + with k @a + (defined at T10267.hs:14:3) + l :: forall a. a -> a + with l @a + (defined at T10267.hs:23:3) + foo :: forall a. a -> a + with foo @a + (defined at T10267.hs:33:1) + id :: forall a. a -> a + with id @a + (imported from ‘Prelude’ at T10267.hs:3:8-13 + (and originally defined in ‘GHC.Base’)) T10267.hs:14:3: error: • Found hole: _foo :: a -> a @@ -32,6 +51,24 @@ T10267.hs:14:3: error: • In the expression: _foo In an equation for ‘k’: k = _foo • Relevant bindings include k :: a -> a (bound at T10267.hs:14:3) + Valid hole fits include + k :: a -> a (bound at T10267.hs:14:3) + j :: forall a0. a0 -> a0 + with j @a + (bound at T10267.hs:8:1) + i :: forall a0. a0 -> a0 + with i @a + (bound at T10267.hs:8:1) + l :: forall a. a -> a + with l @a + (defined at T10267.hs:23:3) + foo :: forall a. a -> a + with foo @a + (defined at T10267.hs:33:1) + id :: forall a. a -> a + with id @a + (imported from ‘Prelude’ at T10267.hs:3:8-13 + (and originally defined in ‘GHC.Base’)) T10267.hs:23:3: error: • Found hole: _ :: a @@ -44,3 +81,4 @@ T10267.hs:23:3: error: • Relevant bindings include x :: a (bound at T10267.hs:23:3) l :: a -> a (bound at T10267.hs:23:3) + Valid hole fits include x :: a (bound at T10267.hs:23:3) diff --git a/testsuite/tests/th/T10638.hs b/testsuite/tests/th/T10638.hs index 7dd17eba41..0cf2440690 100644 --- a/testsuite/tests/th/T10638.hs +++ b/testsuite/tests/th/T10638.hs @@ -10,7 +10,7 @@ import GHC.Exts headers and the static keyword. -} --- check that quasiquoting roundtrips succesfully and that the declaration +-- check that quasiquoting roundtrips successfully and that the declaration -- does not include the static keyword test1 :: String test1 = $(do (ds@[ForeignD (ImportF _ _ p _ _)]) <- diff --git a/testsuite/tests/th/T10828.stderr b/testsuite/tests/th/T10828.stderr index 70ed74bc1e..455be91914 100644 --- a/testsuite/tests/th/T10828.stderr +++ b/testsuite/tests/th/T10828.stderr @@ -8,9 +8,9 @@ newtype Bar_13 :: * -> GHC.Types.Bool -> * = MkBar_14 :: a_15 -> Bar_13 a_15 b_16 data T10828.T (a_0 :: *) where T10828.MkT :: forall (a_1 :: *) . a_1 -> a_1 -> T10828.T a_1 - T10828.MkC :: forall (a_2 :: *) (b_3 :: *) . (Data.Type.Equality.~) a_2 - GHC.Types.Int => {T10828.foo :: a_2, - T10828.bar :: b_3} -> T10828.T GHC.Types.Int + T10828.MkC :: forall (a_2 :: *) (b_3 :: *) . (GHC.Types.~) a_2 + GHC.Types.Int => {T10828.foo :: a_2, + T10828.bar :: b_3} -> T10828.T GHC.Types.Int data T'_0 a_1 :: * where MkT'_2 :: a_3 -> a_3 -> T'_0 a_3 MkC'_4 :: forall a_5 b_6 . a_5 ~ GHC.Types.Int => {foo_7 :: a_5, diff --git a/testsuite/tests/th/T10891.stderr b/testsuite/tests/th/T10891.stderr index 874f4f0890..6b382e61d9 100644 --- a/testsuite/tests/th/T10891.stderr +++ b/testsuite/tests/th/T10891.stderr @@ -1,11 +1,9 @@ class T10891.C (a_0 :: *) - where T10891.f :: forall (a_0 :: *) . T10891.C a_0 => - a_0 -> GHC.Types.Int + where T10891.f :: a_0 -> GHC.Types.Int class T10891.C' (a_0 :: *) where type T10891.F (a_0 :: *) :: * type T10891.F a_0 = a_0 - T10891.f' :: forall (a_0 :: *) . T10891.C' a_0 => - a_0 -> GHC.Types.Int + T10891.f' :: a_0 -> GHC.Types.Int instance T10891.C' GHC.Types.Int class T10891.C'' (a_0 :: *) where data T10891.Fd (a_0 :: *) :: * diff --git a/testsuite/tests/th/T11463.hs b/testsuite/tests/th/T11463.hs index 1faf5964f4..3cb57d1cea 100644 --- a/testsuite/tests/th/T11463.hs +++ b/testsuite/tests/th/T11463.hs @@ -1,5 +1,5 @@ {-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE TypeInType #-} +{-# LANGUAGE DataKinds, PolyKinds #-} module Main where import Data.Kind diff --git a/testsuite/tests/th/T11484.hs b/testsuite/tests/th/T11484.hs index d8c0708bd2..e1e30fc694 100644 --- a/testsuite/tests/th/T11484.hs +++ b/testsuite/tests/th/T11484.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE TypeInType #-} +{-# LANGUAGE PolyKinds #-} module T11484 where diff --git a/testsuite/tests/th/T11721_TH.hs b/testsuite/tests/th/T11721_TH.hs new file mode 100644 index 0000000000..979ff15b0d --- /dev/null +++ b/testsuite/tests/th/T11721_TH.hs @@ -0,0 +1,26 @@ +{-# LANGUAGE GADTs #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TemplateHaskell #-} +module T11721_TH where + +import Language.Haskell.TH + +data T a where + MkT :: forall b a. b -> T a + +$(return []) + +main :: IO () +main = print + $(do let rightOrder :: [TyVarBndr] -> Bool + rightOrder [KindedTV b _, KindedTV a _] + = nameBase b == "b" && nameBase a == "a" + rightOrder _ = False + + TyConI (DataD _ _ _ _ + [ForallC con_tvbs1 _ _] _) <- reify ''T + DataConI _ (ForallT con_tvbs2 _ _) _ <- reify 'MkT + + if rightOrder con_tvbs1 && rightOrder con_tvbs2 + then [| () |] + else fail "T11721_TH failed") diff --git a/testsuite/tests/th/T12387.hs b/testsuite/tests/th/T12387.hs new file mode 100644 index 0000000000..550fc99301 --- /dev/null +++ b/testsuite/tests/th/T12387.hs @@ -0,0 +1,10 @@ +{-# LANGUAGE TemplateHaskell #-} +module T12387 where + +import Language.Haskell.TH.Lib + +data Foo = Foo + +$(do d <- instanceD (cxt []) (conT ''Eq `appT` conT ''Foo) + [funD 'compare [clause [] (normalB $ varE 'undefined) []]] + return [d]) diff --git a/testsuite/tests/th/T12387.stderr b/testsuite/tests/th/T12387.stderr new file mode 100644 index 0000000000..81c2eef5f7 --- /dev/null +++ b/testsuite/tests/th/T12387.stderr @@ -0,0 +1,4 @@ + +T12387.hs:8:3: error: + • Class ‘Eq’ does not have a method ‘compare’ + • In the instance declaration for ‘Eq Foo’ diff --git a/testsuite/tests/th/T12403.stdout b/testsuite/tests/th/T12403.stdout index 386b1c0a89..9b75e8b272 100644 --- a/testsuite/tests/th/T12403.stdout +++ b/testsuite/tests/th/T12403.stdout @@ -1,5 +1 @@ -data Main.T - = Main.T ((# , #) GHC.Types.Int - GHC.Types.Int :: GHC.Prim.TYPE (GHC.Types.TupleRep ((GHC.Types.:) GHC.Types.LiftedRep - ((GHC.Types.:) GHC.Types.LiftedRep - GHC.Types.[])))) +data Main.T = Main.T ((# , #) GHC.Types.Int GHC.Types.Int) diff --git a/testsuite/tests/th/T12478_1.stdout b/testsuite/tests/th/T12478_1.stdout index f94db5992d..8437f925d5 100644 --- a/testsuite/tests/th/T12478_1.stdout +++ b/testsuite/tests/th/T12478_1.stdout @@ -1 +1 @@ -TyConI (DataD [] Main.T [] Nothing [NormalC Main.T [(Bang NoSourceUnpackedness NoSourceStrictness,SigT (AppT (AppT (UnboxedSumT 2) (ConT GHC.Types.Int)) (ConT GHC.Types.Char)) (AppT (ConT GHC.Prim.TYPE) (AppT (ConT GHC.Types.SumRep) (AppT (AppT (ConT GHC.Types.:) (ConT GHC.Types.LiftedRep)) (AppT (AppT (ConT GHC.Types.:) (ConT GHC.Types.LiftedRep)) (ConT GHC.Types.[]))))))]] []) +TyConI (DataD [] Main.T [] Nothing [NormalC Main.T [(Bang NoSourceUnpackedness NoSourceStrictness,AppT (AppT (UnboxedSumT 2) (ConT GHC.Types.Int)) (ConT GHC.Types.Char))]] []) diff --git a/testsuite/tests/th/T13366.hs b/testsuite/tests/th/T13366.hs index 2573235a01..6a3bda3d09 100644 --- a/testsuite/tests/th/T13366.hs +++ b/testsuite/tests/th/T13366.hs @@ -7,7 +7,7 @@ import System.IO (hFlush, stdout) foreign import ccall fc :: Int -> IO Int -do addForeignFile LangC $ unlines +do addForeignSource LangC $ unlines [ "#include <stdio.h>" , "int fc(int x) {" , " printf(\"calling f(%d)\\n\",x);" @@ -19,7 +19,7 @@ do addForeignFile LangC $ unlines foreign import ccall fcxx :: Int -> IO Int -do addForeignFile LangCxx $ unlines +do addForeignSource LangCxx $ unlines [ "#include <iostream>" , "extern \"C\" {" , " int fcxx(int x) {" diff --git a/testsuite/tests/th/T13642.hs b/testsuite/tests/th/T13642.hs index 35aee30ddb..ab655c0e4a 100644 --- a/testsuite/tests/th/T13642.hs +++ b/testsuite/tests/th/T13642.hs @@ -1,9 +1,9 @@ -{-# LANGUAGE GADTs, TypeInType, TemplateHaskell, RankNTypes #-} +{-# LANGUAGE GADTs, PolyKinds, TemplateHaskell, RankNTypes #-} module T13642 where import Data.Kind (Type) import Language.Haskell.TH (stringE, pprint) foo :: IO () -foo = $([d| data Foo :: forall a. a -> Type where MkFoo :: Foo Int |] - >>= \d -> stringE (pprint d)) +foo = putStrLn $([d| data Foo :: forall a. a -> Type where MkFoo :: Foo Int |] + >>= \d -> stringE (pprint d)) diff --git a/testsuite/tests/th/T13642.stderr b/testsuite/tests/th/T13642.stderr deleted file mode 100644 index a6ff054a26..0000000000 --- a/testsuite/tests/th/T13642.stderr +++ /dev/null @@ -1,4 +0,0 @@ - -T13642.hs:8:9: error: - Exotic form of kind not (yet) handled by Template Haskell - forall a. a -> Type diff --git a/testsuite/tests/th/T13776.hs b/testsuite/tests/th/T13776.hs new file mode 100644 index 0000000000..6082825592 --- /dev/null +++ b/testsuite/tests/th/T13776.hs @@ -0,0 +1,23 @@ +{-# LANGUAGE TemplateHaskell #-} + +module T13776 where + +import Language.Haskell.TH + +spliceTy1 :: $(conT ''(,) `appT` conT ''Int `appT` conT ''Int) +spliceTy1 = (1,2) + +spliceTy2 :: $(conT ''[] `appT` conT ''Int) +spliceTy2 = [] + +spliceExp1 :: (Int, Int) +spliceExp1 = $(conE '(,) `appE` litE (integerL 1) `appE` litE (integerL 1)) + +spliceExp2 :: [Int] +spliceExp2 = $(conE '[]) + +splicePat1 :: (Int, Int) -> () +splicePat1 $(conP '(,) [litP (integerL 1), litP (integerL 1)]) = () + +splicePat2 :: [Int] -> () +splicePat2 $(conP '[] []) = () diff --git a/testsuite/tests/th/T13776.stderr b/testsuite/tests/th/T13776.stderr new file mode 100644 index 0000000000..485dc64a28 --- /dev/null +++ b/testsuite/tests/th/T13776.stderr @@ -0,0 +1,14 @@ +T13776.hs:10:16-42: Splicing type + conT ''[] `appT` conT ''Int ======> [] Int +T13776.hs:7:16-61: Splicing type + conT ''(,) `appT` conT ''Int `appT` conT ''Int ======> (,) Int Int +T13776.hs:14:16-74: Splicing expression + conE '(,) `appE` litE (integerL 1) `appE` litE (integerL 1) + ======> + ((,) 1) 1 +T13776.hs:17:16-23: Splicing expression + conE '[] ======> [] +T13776.hs:20:14-61: Splicing pattern + conP '(,) [litP (integerL 1), litP (integerL 1)] ======> (,) 1 1 +T13776.hs:23:14-24: Splicing pattern + conP '[] [] ======> [] diff --git a/testsuite/tests/th/T13781.hs b/testsuite/tests/th/T13781.hs index 7498f56bae..2fd2f1a3d4 100644 --- a/testsuite/tests/th/T13781.hs +++ b/testsuite/tests/th/T13781.hs @@ -1,5 +1,5 @@ {-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE TypeInType #-} +{-# LANGUAGE PolyKinds #-} module T13781 where import Data.Kind diff --git a/testsuite/tests/th/T13837.hs b/testsuite/tests/th/T13837.hs new file mode 100644 index 0000000000..3d33341e4d --- /dev/null +++ b/testsuite/tests/th/T13837.hs @@ -0,0 +1,10 @@ +{-# LANGUAGE TemplateHaskell #-} +module T13837 where + +import Language.Haskell.TH.Lib +import Language.Haskell.TH.Syntax + +test_local_tyfam_expansion :: String +test_local_tyfam_expansion = + $(do fam_name <- newName "Fam" + stringE . show =<< qReifyInstances fam_name []) diff --git a/testsuite/tests/th/T13837.stderr b/testsuite/tests/th/T13837.stderr new file mode 100644 index 0000000000..53700b5a7a --- /dev/null +++ b/testsuite/tests/th/T13837.stderr @@ -0,0 +1,10 @@ + +T13837.hs:9:5: error: + • The exact Name ‘Fam’ is not in scope + Probable cause: you used a unique Template Haskell name (NameU), + perhaps via newName, but did not bind it + If that's it, then -ddump-splices might be useful + • In the argument of reifyInstances: Fam_0 + In the untyped splice: + $(do fam_name <- newName "Fam" + stringE . show =<< qReifyInstances fam_name []) diff --git a/testsuite/tests/th/T13885.hs b/testsuite/tests/th/T13885.hs new file mode 100644 index 0000000000..cdcc37f426 --- /dev/null +++ b/testsuite/tests/th/T13885.hs @@ -0,0 +1,24 @@ +{-# LANGUAGE GADTs #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} +module Main where + +import Data.Function (on) +import Language.Haskell.TH.Syntax + +data a :~: b where + Refl :: a ~ b => a :~: b + +$(return []) + +main :: IO () +main = print + $(do TyConI (DataD _ _ tycon_tyvars _ + [ForallC con_tyvars _ _] _) <- reify ''(:~:) + + let tvbName :: TyVarBndr -> Name + tvbName (PlainTV n) = n + tvbName (KindedTV n _) = n + + lift $ and $ zipWith ((/=) `on` tvbName) tycon_tyvars con_tyvars) diff --git a/testsuite/tests/th/T13885.stdout b/testsuite/tests/th/T13885.stdout new file mode 100644 index 0000000000..0ca95142bb --- /dev/null +++ b/testsuite/tests/th/T13885.stdout @@ -0,0 +1 @@ +True diff --git a/testsuite/tests/th/T13887.hs b/testsuite/tests/th/T13887.hs new file mode 100644 index 0000000000..8687447d16 --- /dev/null +++ b/testsuite/tests/th/T13887.hs @@ -0,0 +1,13 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE TemplateHaskell #-} +module Main where + +import Data.Proxy +import GHC.Generics +import Language.Haskell.TH + +main :: IO () +main = do + putStrLn $([t| Proxy (:*:) |] >>= stringE . pprint) + putStrLn $([t| Proxy '(:*:) |] >>= stringE . pprint) + putStrLn $([t| Proxy '(:) |] >>= stringE . pprint) diff --git a/testsuite/tests/th/T13887.stdout b/testsuite/tests/th/T13887.stdout new file mode 100644 index 0000000000..48845be60a --- /dev/null +++ b/testsuite/tests/th/T13887.stdout @@ -0,0 +1,3 @@ +Data.Proxy.Proxy (GHC.Generics.:*:) +Data.Proxy.Proxy '(GHC.Generics.:*:) +Data.Proxy.Proxy '(GHC.Types.:) diff --git a/testsuite/tests/th/T13968.hs b/testsuite/tests/th/T13968.hs new file mode 100644 index 0000000000..1e54ef12f3 --- /dev/null +++ b/testsuite/tests/th/T13968.hs @@ -0,0 +1,6 @@ +{-# LANGUAGE TemplateHaskell #-} +module T13968 where + +import Language.Haskell.TH + +$(pure [ValD (VarP 'succ) (NormalB (ConE 'True)) []]) diff --git a/testsuite/tests/th/T13968.stderr b/testsuite/tests/th/T13968.stderr new file mode 100644 index 0000000000..2850dae0c5 --- /dev/null +++ b/testsuite/tests/th/T13968.stderr @@ -0,0 +1,3 @@ + +T13968.hs:6:3: error: + Cannot redefine a Name retrieved by a Template Haskell quote: succ diff --git a/testsuite/tests/th/T14060.hs b/testsuite/tests/th/T14060.hs new file mode 100644 index 0000000000..8c4f2ddc95 --- /dev/null +++ b/testsuite/tests/th/T14060.hs @@ -0,0 +1,38 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE ExistentialQuantification #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeFamilyDependencies #-} +{-# LANGUAGE PolyKinds #-} +module Main where + +import Data.Kind +import Data.Proxy +import Language.Haskell.TH hiding (Type) + +-- Anonymous tyvar binder example +newtype Foo1 = Foo1 (Proxy '[False, True, False]) + +-- Required (dependent) tyvar binder example +type family Wurble k (a :: k) :: k +newtype Foo2 a = Foo2 (Proxy (Wurble (Maybe a) Nothing)) + +-- Non-injective type family example +type family Foo3Fam1 (a :: Type) :: Type where + Foo3Fam1 a = a +type family Foo3Fam2 (a :: Foo3Fam1 b) :: b +newtype Foo3 = Foo3 (Proxy (Foo3Fam2 Int)) + +-- Injective type family example +type family Foo4Fam1 (a :: Type) = (r :: Type) | r -> a where + Foo4Fam1 a = a +type family Foo4Fam2 (a :: Foo4Fam1 b) :: b +newtype Foo4 = Foo4 (Proxy (Foo4Fam2 Int)) + +$(return []) + +main :: IO () +main = do + putStrLn $(reify ''Foo1 >>= stringE . pprint) + putStrLn $(reify ''Foo2 >>= stringE . pprint) + putStrLn $(reify ''Foo3 >>= stringE . pprint) + putStrLn $(reify ''Foo4 >>= stringE . pprint) diff --git a/testsuite/tests/th/T14060.stdout b/testsuite/tests/th/T14060.stdout new file mode 100644 index 0000000000..01857c3015 --- /dev/null +++ b/testsuite/tests/th/T14060.stdout @@ -0,0 +1,11 @@ +newtype Main.Foo1 + = Main.Foo1 (Data.Proxy.Proxy ('(:) 'GHC.Types.False + ('(:) 'GHC.Types.True + ('(:) 'GHC.Types.False ('[] :: [GHC.Types.Bool]))))) +newtype Main.Foo2 (a_0 :: *) + = Main.Foo2 (Data.Proxy.Proxy (Main.Wurble (GHC.Maybe.Maybe a_0) + ('GHC.Maybe.Nothing :: GHC.Maybe.Maybe a_0))) +newtype Main.Foo3 + = Main.Foo3 (Data.Proxy.Proxy (Main.Foo3Fam2 GHC.Types.Int :: *)) +newtype Main.Foo4 + = Main.Foo4 (Data.Proxy.Proxy (Main.Foo4Fam2 GHC.Types.Int)) diff --git a/testsuite/tests/th/T14204.hs b/testsuite/tests/th/T14204.hs new file mode 100644 index 0000000000..e952dbd5a7 --- /dev/null +++ b/testsuite/tests/th/T14204.hs @@ -0,0 +1,8 @@ +{-# LANGUAGE TemplateHaskell #-} +module T14204 where + +import GHC.StaticPtr +import Language.Haskell.TH + +main :: IO () +main = putStrLn (deRefStaticPtr $(pure (StaticE (LitE (StringL "wat"))))) diff --git a/testsuite/tests/th/T14204.stderr b/testsuite/tests/th/T14204.stderr new file mode 100644 index 0000000000..90150e2050 --- /dev/null +++ b/testsuite/tests/th/T14204.stderr @@ -0,0 +1,5 @@ + +T14204.hs:8:35: error: + • Illegal static expression: static "wat" + Use StaticPointers to enable this extension + • In the untyped splice: $(pure (StaticE (LitE (StringL "wat")))) diff --git a/testsuite/tests/th/T14298.hs b/testsuite/tests/th/T14298.hs new file mode 100644 index 0000000000..7896e491cb --- /dev/null +++ b/testsuite/tests/th/T14298.hs @@ -0,0 +1,24 @@ +{-# LANGUAGE ForeignFunctionInterface #-} +{-# LANGUAGE TemplateHaskell #-} + +import Language.Haskell.TH.Syntax +import System.IO (hFlush, stdout) + +foreign import ccall foo :: Int -> IO Int + +do fpIn <- addTempFile "c" + let cSrc = (unlines [ "#include <stdio.h>" + , "int foo(int x) {" + , " printf(\"calling f(%d)\\n\",x);" + , " fflush(stdout);" + , " return 1 + x;" + , "}" + ]) + runIO $ writeFile fpIn cSrc + addForeignFilePath LangC fpIn + return [] + +main :: IO () +main = do + foo 2 >>= print + hFlush stdout diff --git a/testsuite/tests/th/T14298.stdout b/testsuite/tests/th/T14298.stdout new file mode 100644 index 0000000000..2ab79e85b8 --- /dev/null +++ b/testsuite/tests/th/T14298.stdout @@ -0,0 +1,2 @@ +calling f(2) +3 diff --git a/testsuite/tests/th/T14471.hs b/testsuite/tests/th/T14471.hs new file mode 100644 index 0000000000..e1355b1ae5 --- /dev/null +++ b/testsuite/tests/th/T14471.hs @@ -0,0 +1,13 @@ +{-# LANGUAGE ApplicativeDo #-} +{-# LANGUAGE TemplateHaskell #-} + +import Language.Haskell.TH +import Prelude + +main = putStrLn $(do + expr <- [| + do x <- getLine + y <- getLine + pure (x, y) + |] + stringE (pprint expr)) diff --git a/testsuite/tests/th/T14471.stdout b/testsuite/tests/th/T14471.stdout new file mode 100644 index 0000000000..f9f15f9e2d --- /dev/null +++ b/testsuite/tests/th/T14471.stdout @@ -0,0 +1,3 @@ +do {x_0 <- System.IO.getLine; + y_1 <- System.IO.getLine; + GHC.Base.return (x_0, y_1)} diff --git a/testsuite/tests/th/T14627.hs b/testsuite/tests/th/T14627.hs new file mode 100644 index 0000000000..aebf6bd4b8 --- /dev/null +++ b/testsuite/tests/th/T14627.hs @@ -0,0 +1,6 @@ +{-# LANGUAGE TemplateHaskell #-} +import Language.Haskell.TH.Syntax + +[d| f = Bool |] >>= addTopDecls >> return [] + +main = return () diff --git a/testsuite/tests/th/T14627.stderr b/testsuite/tests/th/T14627.stderr new file mode 100644 index 0000000000..1db648811b --- /dev/null +++ b/testsuite/tests/th/T14627.stderr @@ -0,0 +1,2 @@ + +T14627.hs:4:1: error: Data constructor not in scope: Bool diff --git a/testsuite/tests/th/T14646.hs b/testsuite/tests/th/T14646.hs new file mode 100644 index 0000000000..c85872365f --- /dev/null +++ b/testsuite/tests/th/T14646.hs @@ -0,0 +1,6 @@ +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE TemplateHaskell #-} +module T14646 where + +$([d| f :: (forall a. a) -> Int + f _ = undefined |]) diff --git a/testsuite/tests/th/T14646.stderr b/testsuite/tests/th/T14646.stderr new file mode 100644 index 0000000000..869cf6fd01 --- /dev/null +++ b/testsuite/tests/th/T14646.stderr @@ -0,0 +1,6 @@ +T14646.hs:(5,3)-(6,24): Splicing declarations + [d| f :: (forall a. a) -> Int + f _ = undefined |] + ======> + f :: (forall a. a) -> Int + f _ = undefined diff --git a/testsuite/tests/th/T14681.hs b/testsuite/tests/th/T14681.hs new file mode 100644 index 0000000000..341a1a66b1 --- /dev/null +++ b/testsuite/tests/th/T14681.hs @@ -0,0 +1,9 @@ +{-# LANGUAGE TemplateHaskell #-} +module T14681 where + +import Data.Functor.Identity +import Language.Haskell.TH + +$([d| f = \(Identity x) -> x |]) +$([d| g = $(pure $ VarE '(+) `AppE` LitE (IntegerL (-1)) + `AppE` (LitE (IntegerL (-1)))) |]) diff --git a/testsuite/tests/th/T14681.stderr b/testsuite/tests/th/T14681.stderr new file mode 100644 index 0000000000..debb18dee5 --- /dev/null +++ b/testsuite/tests/th/T14681.stderr @@ -0,0 +1,11 @@ +T14681.hs:7:3-31: Splicing declarations + [d| f = \ (Identity x) -> x |] ======> f = \ (Identity x) -> x +T14681.hs:(8,3)-(9,62): Splicing declarations + [d| g = $(pure + $ VarE '(+) `AppE` LitE (IntegerL (- 1)) + `AppE` (LitE (IntegerL (- 1)))) |] + pending(rn) [<splice, pure + $ VarE '(+) `AppE` LitE (IntegerL (- 1)) + `AppE` (LitE (IntegerL (- 1)))>] + ======> + g = ((+) (-1)) (-1) diff --git a/testsuite/tests/th/T14817.hs b/testsuite/tests/th/T14817.hs new file mode 100644 index 0000000000..1019decb61 --- /dev/null +++ b/testsuite/tests/th/T14817.hs @@ -0,0 +1,6 @@ +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeFamilies #-} +module T14817 where + +$([d| data family Foo :: * + data instance Foo :: * |]) diff --git a/testsuite/tests/th/T14817.stderr b/testsuite/tests/th/T14817.stderr new file mode 100644 index 0000000000..7c63763bae --- /dev/null +++ b/testsuite/tests/th/T14817.stderr @@ -0,0 +1,7 @@ +T14817.hs:(5,3)-(6,31): Splicing declarations + [d| data family Foo :: * + + data instance Foo :: * |] + ======> + data family Foo :: GHC.Types.Type + data instance Foo :: GHC.Types.Type diff --git a/testsuite/tests/th/T14843.hs b/testsuite/tests/th/T14843.hs new file mode 100644 index 0000000000..505fa51334 --- /dev/null +++ b/testsuite/tests/th/T14843.hs @@ -0,0 +1,9 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE TemplateHaskell #-} +module T14843 where + +import Language.Haskell.TH.Syntax + +type T1 = $(return (PromotedTupleT 2)) +type T2 = $([t| '(,) |]) +type T3 = $(return (PromotedT (tupleDataName 2))) diff --git a/testsuite/tests/th/T14869.hs b/testsuite/tests/th/T14869.hs new file mode 100644 index 0000000000..4b0dcdc171 --- /dev/null +++ b/testsuite/tests/th/T14869.hs @@ -0,0 +1,25 @@ +{-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE DataKinds #-} +module T14869 where + +import Data.Kind +import GHC.Exts +import Language.Haskell.TH (pprint, reify, stringE) + +type MyConstraint = Constraint +type MyLiftedRep = LiftedRep + +type family Foo1 :: Type +type family Foo2 :: Constraint +type family Foo3 :: MyConstraint +type family Foo4 :: TYPE MyLiftedRep + +$(pure []) + +foo1, foo2, foo3 :: String +foo1 = $(reify ''Foo1 >>= stringE . pprint) +foo2 = $(reify ''Foo2 >>= stringE . pprint) +foo3 = $(reify ''Foo3 >>= stringE . pprint) +foo4 = $(reify ''Foo4 >>= stringE . pprint) diff --git a/testsuite/tests/th/T14869.stderr b/testsuite/tests/th/T14869.stderr new file mode 100644 index 0000000000..a2776b8cc8 --- /dev/null +++ b/testsuite/tests/th/T14869.stderr @@ -0,0 +1,17 @@ +T14869.hs:19:3-9: Splicing declarations pure [] ======> +T14869.hs:22:10-42: Splicing expression + reify ''Foo1 >>= stringE . pprint + ======> + "type family T14869.Foo1 :: *" +T14869.hs:23:10-42: Splicing expression + reify ''Foo2 >>= stringE . pprint + ======> + "type family T14869.Foo2 :: Constraint" +T14869.hs:24:10-42: Splicing expression + reify ''Foo3 >>= stringE . pprint + ======> + "type family T14869.Foo3 :: T14869.MyConstraint" +T14869.hs:25:10-42: Splicing expression + reify ''Foo4 >>= stringE . pprint + ======> + "type family T14869.Foo4 :: *" diff --git a/testsuite/tests/th/T14875.hs b/testsuite/tests/th/T14875.hs new file mode 100644 index 0000000000..e601d36da8 --- /dev/null +++ b/testsuite/tests/th/T14875.hs @@ -0,0 +1,14 @@ +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TemplateHaskell #-} +module T14875 where + +$([d| f :: Bool -> Bool + f x = case x of + (True :: Bool) -> True + (False :: Bool) -> False + + g :: Bool -> Bool + g x = (case x of + True -> True + False -> False) :: Bool + |]) diff --git a/testsuite/tests/th/T14875.stderr b/testsuite/tests/th/T14875.stderr new file mode 100644 index 0000000000..09374f243d --- /dev/null +++ b/testsuite/tests/th/T14875.stderr @@ -0,0 +1,24 @@ +T14875.hs:(5,3)-(14,6): Splicing declarations + [d| f :: Bool -> Bool + f x + = case x of + (True :: Bool) -> True + (False :: Bool) -> False + g :: Bool -> Bool + g x + = (case x of + True -> True + False -> False) :: + Bool |] + ======> + f :: Bool -> Bool + f x + = case x of + (True :: Bool) -> True + (False :: Bool) -> False + g :: Bool -> Bool + g x + = (case x of + True -> True + False -> False) :: + Bool diff --git a/testsuite/tests/th/T14885a.hs b/testsuite/tests/th/T14885a.hs new file mode 100644 index 0000000000..0971606dc5 --- /dev/null +++ b/testsuite/tests/th/T14885a.hs @@ -0,0 +1,18 @@ +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE InstanceSigs #-} + +module T14885a where + +class Foo1 a where + bar1 :: forall b. a -> b -> b + bar1 _ x = (x :: b) + +$([d| class Foo2 a where + bar2 :: forall b. a -> b -> b + bar2 _ x = (x :: b) + + instance Foo2 Int where + bar2 :: forall b. Int -> b -> b + bar2 _ x = (x :: b) + |]) diff --git a/testsuite/tests/th/T14885b.hs b/testsuite/tests/th/T14885b.hs new file mode 100644 index 0000000000..c54c67eb93 --- /dev/null +++ b/testsuite/tests/th/T14885b.hs @@ -0,0 +1,16 @@ +{-# LANGUAGE DefaultSignatures #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TemplateHaskell #-} + +module T14885b where + +class Foo1 a where + foo1 :: forall b. a -> b -> b + default foo1 :: forall b. a -> b -> b + foo1 _ x = (x :: b) + +$([d| class Foo2 a where + foo2 :: forall b. a -> b -> b + default foo2 :: forall b. a -> b -> b + foo2 _ x = (x :: b) + |]) diff --git a/testsuite/tests/th/T14885c.hs b/testsuite/tests/th/T14885c.hs new file mode 100644 index 0000000000..f446a3e3cd --- /dev/null +++ b/testsuite/tests/th/T14885c.hs @@ -0,0 +1,14 @@ +{-# LANGUAGE PatternSynonyms #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TemplateHaskell #-} + +module T14885c where + +pattern P1 :: forall a. a -> Maybe a +pattern P1 x <- Just x where + P1 x = Just (x :: a) + +$([d| pattern P2 :: forall a. a -> Maybe a + pattern P2 x <- Just x where + P2 x = Just (x :: a) + |]) diff --git a/testsuite/tests/th/T14888.hs b/testsuite/tests/th/T14888.hs new file mode 100644 index 0000000000..e2bcec64ea --- /dev/null +++ b/testsuite/tests/th/T14888.hs @@ -0,0 +1,18 @@ +{-# LANGUAGE TemplateHaskell #-} +module T14888 where + +import Language.Haskell.TH + +foo :: $([t| (->) Bool Bool |]) +foo x = x + +class Functor' f where + fmap' :: (a -> b) -> f a -> f b + +instance Functor' ((->) r) where + fmap' = (.) + +$(return []) + +functor'Instances :: String +functor'Instances = $(reify ''Functor' >>= stringE . pprint) diff --git a/testsuite/tests/th/T14888.stderr b/testsuite/tests/th/T14888.stderr new file mode 100644 index 0000000000..e6d63254e7 --- /dev/null +++ b/testsuite/tests/th/T14888.stderr @@ -0,0 +1,10 @@ +T14888.hs:6:10-30: Splicing type + [t| (->) Bool Bool |] ======> Bool -> Bool +T14888.hs:15:3-11: Splicing declarations return [] ======> +T14888.hs:18:23-59: Splicing expression + reify ''Functor' >>= stringE . pprint + ======> + "class T14888.Functor' (f_0 :: * -> *) + where T14888.fmap' :: forall (a_1 :: *) (b_2 :: *) . + (a_1 -> b_2) -> f_0 a_1 -> f_0 b_2 +instance T14888.Functor' ((->) r_3 :: * -> *)" diff --git a/testsuite/tests/th/T15243.hs b/testsuite/tests/th/T15243.hs new file mode 100644 index 0000000000..8b366404c8 --- /dev/null +++ b/testsuite/tests/th/T15243.hs @@ -0,0 +1,15 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeFamilies #-} +{-# OPTIONS_GHC -ddump-splices #-} +module T15243 where + +data Unit = Unit + +$([d| type family F (a :: k) :: k where + F 'Unit = 'Unit + F '(,) = '(,) + F '[] = '[] + F '(:) = '(:) + |]) diff --git a/testsuite/tests/th/T15243.stderr b/testsuite/tests/th/T15243.stderr new file mode 100644 index 0000000000..4e50186c1f --- /dev/null +++ b/testsuite/tests/th/T15243.stderr @@ -0,0 +1,12 @@ +T15243.hs:(10,3)-(15,6): Splicing declarations + [d| type family F (a :: k) :: k where + F 'Unit = 'Unit + F '(,) = '(,) + F '[] = '[] + F '(:) = '(:) |] + ======> + type family F (a :: k) :: k where + F 'Unit = 'Unit + F '(,) = '(,) + F '[] = '[] + F '(:) = '(:) diff --git a/testsuite/tests/th/T15321.hs b/testsuite/tests/th/T15321.hs new file mode 100644 index 0000000000..0f0b4d5183 --- /dev/null +++ b/testsuite/tests/th/T15321.hs @@ -0,0 +1,9 @@ +{-# LANGUAGE TemplateHaskell #-} + +module T15321 where + +foo :: String +foo = test + +bar :: String +bar = $(_ "baz") diff --git a/testsuite/tests/th/T15321.stderr b/testsuite/tests/th/T15321.stderr new file mode 100644 index 0000000000..7807bcf5a2 --- /dev/null +++ b/testsuite/tests/th/T15321.stderr @@ -0,0 +1,12 @@ + +T15321.hs:9:9: error: + • Found hole: _ :: [Char] -> Language.Haskell.TH.Lib.Internal.ExpQ + • In the expression: _ + In the expression: _ "baz" + In the untyped splice: $(_ "baz") + • Valid hole fits include + fail :: forall (m :: * -> *) a. Monad m => String -> m a + with fail @Language.Haskell.TH.Syntax.Q + @Language.Haskell.TH.Syntax.Exp + (imported from ‘Prelude’ at T15321.hs:3:8-13 + (and originally defined in ‘GHC.Base’)) diff --git a/testsuite/tests/th/T15324.hs b/testsuite/tests/th/T15324.hs new file mode 100644 index 0000000000..ea124f4dc7 --- /dev/null +++ b/testsuite/tests/th/T15324.hs @@ -0,0 +1,7 @@ +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE TemplateHaskell #-} +module T15324 where + +$([d| f :: forall a. (Show a => a) -> a + f _ = undefined + |]) diff --git a/testsuite/tests/th/T15324.stderr b/testsuite/tests/th/T15324.stderr new file mode 100644 index 0000000000..49db9ed8d9 --- /dev/null +++ b/testsuite/tests/th/T15324.stderr @@ -0,0 +1,6 @@ +T15324.hs:(5,3)-(7,6): Splicing declarations + [d| f :: forall a. (Show a => a) -> a + f _ = undefined |] + ======> + f :: forall a. (Show a => a) -> a + f _ = undefined diff --git a/testsuite/tests/th/T15331.hs b/testsuite/tests/th/T15331.hs new file mode 100644 index 0000000000..0b0a076d9f --- /dev/null +++ b/testsuite/tests/th/T15331.hs @@ -0,0 +1,9 @@ +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeApplications #-} +module T15331 where + +import Data.Proxy + +$([d| f :: Proxy (Int -> Int) + f = Proxy @(Int -> Int) + |]) diff --git a/testsuite/tests/th/T15331.stderr b/testsuite/tests/th/T15331.stderr new file mode 100644 index 0000000000..99bfdfd198 --- /dev/null +++ b/testsuite/tests/th/T15331.stderr @@ -0,0 +1,6 @@ +T15331.hs:(7,3)-(9,6): Splicing declarations + [d| f :: Proxy (Int -> Int) + f = Proxy @(Int -> Int) |] + ======> + f :: Proxy (Int -> Int) + f = Proxy @(Int -> Int) diff --git a/testsuite/tests/th/T15365.hs b/testsuite/tests/th/T15365.hs new file mode 100644 index 0000000000..00ff2e644d --- /dev/null +++ b/testsuite/tests/th/T15365.hs @@ -0,0 +1,31 @@ +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE PatternSynonyms #-} +{-# LANGUAGE RoleAnnotations #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} +module T15365 where + +$([d| type (|||) = Either + + (&&&) :: Bool -> Bool -> Bool + (&&&) = (&&) + + type role (***) + data (***) + + class (???) + instance (???) + + data family ($$$) + data instance ($$$) + + type family (^^^) + type instance (^^^) = Int + + type family (###) where + (###) = Int + + pattern (:!!!) :: Bool + pattern (:!!!) = True + |]) diff --git a/testsuite/tests/th/T15365.stderr b/testsuite/tests/th/T15365.stderr new file mode 100644 index 0000000000..3c85950831 --- /dev/null +++ b/testsuite/tests/th/T15365.stderr @@ -0,0 +1,33 @@ +T15365.hs:(9,3)-(31,6): Splicing declarations + [d| (&&&) :: Bool -> Bool -> Bool + (&&&) = (&&) + pattern (:!!!) :: Bool + pattern (:!!!) = True + + type (|||) = Either + data (***) + class (???) + data family ($$$) + type family (^^^) + type family (###) where + (###) = Int + + instance (???) + data instance ($$$) + type instance (^^^) = Int |] + ======> + type (|||) = Either + (&&&) :: Bool -> Bool -> Bool + (&&&) = (&&) + type role (***) + data (***) + class (???) + instance (???) + data family ($$$) + data instance ($$$) + type family (^^^) + type instance (^^^) = Int + type family (###) where + (###) = Int + pattern (:!!!) :: Bool + pattern (:!!!) = True diff --git a/testsuite/tests/th/T15502.hs b/testsuite/tests/th/T15502.hs new file mode 100644 index 0000000000..96800f8bc6 --- /dev/null +++ b/testsuite/tests/th/T15502.hs @@ -0,0 +1,9 @@ +{-# LANGUAGE TemplateHaskell #-} + +module T15502 where + +import Language.Haskell.TH.Syntax (Lift(lift)) + +main = print ( $( lift (toInteger (maxBound :: Int) + 1) ) + , $( lift (minBound :: Int) ) + ) diff --git a/testsuite/tests/th/T15502.stderr-ws-32 b/testsuite/tests/th/T15502.stderr-ws-32 new file mode 100644 index 0000000000..ba7b91c4a5 --- /dev/null +++ b/testsuite/tests/th/T15502.stderr-ws-32 @@ -0,0 +1,4 @@ +T15502.hs:7:19-56: Splicing expression + lift (toInteger (maxBound :: Int) + 1) ======> 2147483648 +T15502.hs:8:19-40: Splicing expression + lift (minBound :: Int) ======> (-2147483648) diff --git a/testsuite/tests/th/T15502.stderr-ws-64 b/testsuite/tests/th/T15502.stderr-ws-64 new file mode 100644 index 0000000000..1177799775 --- /dev/null +++ b/testsuite/tests/th/T15502.stderr-ws-64 @@ -0,0 +1,4 @@ +T15502.hs:7:19-56: Splicing expression + lift (toInteger (maxBound :: Int) + 1) ======> 9223372036854775808 +T15502.hs:8:19-40: Splicing expression + lift (minBound :: Int) ======> (-9223372036854775808) diff --git a/testsuite/tests/th/T15518.hs b/testsuite/tests/th/T15518.hs new file mode 100644 index 0000000000..eb424a94dd --- /dev/null +++ b/testsuite/tests/th/T15518.hs @@ -0,0 +1,8 @@ +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE TemplateHaskell #-} +module T15518 where + +$([d| f :: Bool -> () + f = \case True -> () + False -> () + |]) diff --git a/testsuite/tests/th/T15518.stderr b/testsuite/tests/th/T15518.stderr new file mode 100644 index 0000000000..7d9ef293b4 --- /dev/null +++ b/testsuite/tests/th/T15518.stderr @@ -0,0 +1,10 @@ +T15518.hs:(5,3)-(8,6): Splicing declarations + [d| f :: Bool -> () + f = \case + True -> () + False -> () |] + ======> + f :: Bool -> () + f = \case + True -> () + False -> () diff --git a/testsuite/tests/th/T15550.hs b/testsuite/tests/th/T15550.hs new file mode 100644 index 0000000000..538064ca25 --- /dev/null +++ b/testsuite/tests/th/T15550.hs @@ -0,0 +1,8 @@ +{-# LANGUAGE TemplateHaskell #-} +module T15550 where + +$([d| myId :: a -> a + myId x = x + {-# NOINLINE [1] myId #-} + {-# RULES "myId" forall x. myId x = x #-} + |]) diff --git a/testsuite/tests/th/T15550.stderr b/testsuite/tests/th/T15550.stderr new file mode 100644 index 0000000000..8169d75613 --- /dev/null +++ b/testsuite/tests/th/T15550.stderr @@ -0,0 +1,11 @@ +T15550.hs:(4,3)-(8,6): Splicing declarations + [d| {-# RULES "myId" forall x. myId x = x #-} + + myId :: a -> a + myId x = x + {-# NOINLINE [1] myId #-} |] + ======> + myId :: a -> a + myId x = x + {-# NOINLINE [1] myId #-} + {-# RULES "myId" forall x. myId x = x #-} diff --git a/testsuite/tests/th/T15572.hs b/testsuite/tests/th/T15572.hs new file mode 100644 index 0000000000..7bbbcacbcd --- /dev/null +++ b/testsuite/tests/th/T15572.hs @@ -0,0 +1,8 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE TemplateHaskell #-} +module T15572 where + +import Language.Haskell.TH + +$([d| type AbsoluteUnit1 = '() |]) +$(pure [TySynD (mkName "AbsoluteUnit2") [] (ConT '())]) diff --git a/testsuite/tests/th/T15572.stderr b/testsuite/tests/th/T15572.stderr new file mode 100644 index 0000000000..27132d69e0 --- /dev/null +++ b/testsuite/tests/th/T15572.stderr @@ -0,0 +1,6 @@ +T15572.hs:7:3-33: Splicing declarations + [d| type AbsoluteUnit1 = '() |] ======> type AbsoluteUnit1 = '() +T15572.hs:8:3-54: Splicing declarations + pure [TySynD (mkName "AbsoluteUnit2") [] (ConT '())] + ======> + type AbsoluteUnit2 = '() diff --git a/testsuite/tests/th/T3177a.stderr b/testsuite/tests/th/T3177a.stderr index e2e8cadbdc..d68be6d1fc 100644 --- a/testsuite/tests/th/T3177a.stderr +++ b/testsuite/tests/th/T3177a.stderr @@ -1,10 +1,8 @@ T3177a.hs:8:8: error: - • Expecting one fewer arguments to ‘Int’ - Expected kind ‘* -> *’, but ‘Int’ has kind ‘*’ + • Expected kind ‘* -> *’, but ‘Int’ has kind ‘*’ • In the type signature: f :: (Int Int) T3177a.hs:11:6: error: - • Expecting one fewer arguments to ‘Int’ - Expected kind ‘* -> *’, but ‘Int’ has kind ‘*’ + • Expected kind ‘* -> *’, but ‘Int’ has kind ‘*’ • In the type signature: g :: Int Int diff --git a/testsuite/tests/th/T3319.stderr b/testsuite/tests/th/T3319.stderr index 44ec90ffe7..b88b10f90f 100644 --- a/testsuite/tests/th/T3319.stderr +++ b/testsuite/tests/th/T3319.stderr @@ -4,4 +4,4 @@ T3319.hs:8:3-93: Splicing declarations (ImportF CCall Unsafe "&" (mkName "foo") (AppT (ConT ''Ptr) (ConT ''())))] ======> - foreign import ccall unsafe "&" foo :: Ptr GHC.Tuple.() + foreign import ccall unsafe "&" foo :: Ptr () diff --git a/testsuite/tests/th/T4135.stderr b/testsuite/tests/th/T4135.stderr index c666082754..3a4c6084d4 100644 --- a/testsuite/tests/th/T4135.stderr +++ b/testsuite/tests/th/T4135.stderr @@ -1,2 +1,2 @@ -instance Bug.C (GHC.Base.Maybe a_0) - where type Bug.T (GHC.Base.Maybe a_0) = GHC.Types.Char +instance Bug.C (GHC.Maybe.Maybe a_0) + where type Bug.T (GHC.Maybe.Maybe a_0) = GHC.Types.Char diff --git a/testsuite/tests/th/T4188.stderr b/testsuite/tests/th/T4188.stderr index 2e4155fd8b..38a22cf172 100644 --- a/testsuite/tests/th/T4188.stderr +++ b/testsuite/tests/th/T4188.stderr @@ -1,8 +1,9 @@ -data T4188.T1 (a_0 :: *) = forall (b_1 :: *) . T4188.MkT1 a_0 b_1 -data T4188.T2 (a_0 :: *) - = forall (b_1 :: *) . (T4188.C a_0, T4188.C b_1) => T4188.MkT2 a_0 - b_1 +data T4188.T1 (a_0 :: *) where + T4188.MkT1 :: forall (a_1 :: *) (b_2 :: *) . a_1 -> + b_2 -> T4188.T1 a_1 +data T4188.T2 (a_0 :: *) where + T4188.MkT2 :: forall (a_1 :: *) (b_2 :: *) . (T4188.C a_1, + T4188.C b_2) => a_1 -> b_2 -> T4188.T2 a_1 data T4188.T3 (x_0 :: *) where T4188.MkT3 :: forall (x_1 :: *) (y_2 :: *) . (T4188.C x_1, T4188.C y_2) => x_1 -> y_2 -> T4188.T3 (x_1, y_2) - diff --git a/testsuite/tests/th/T5037.stderr b/testsuite/tests/th/T5037.stderr index 944cfa5c8c..67d7e2e7c6 100644 --- a/testsuite/tests/th/T5037.stderr +++ b/testsuite/tests/th/T5037.stderr @@ -1,3 +1,3 @@ -f_0 :: GHC.Base.Maybe GHC.Types.Int -> GHC.Types.Int -f_0 (GHC.Base.Nothing) = 3 -f_0 (GHC.Base.Just x_1) = x +f_0 :: GHC.Maybe.Maybe GHC.Types.Int -> GHC.Types.Int +f_0 (GHC.Maybe.Nothing) = 3 +f_0 (GHC.Maybe.Just x_1) = x diff --git a/testsuite/tests/th/T5700.stderr b/testsuite/tests/th/T5700.stderr index 729a36604f..3564b8cb2a 100644 --- a/testsuite/tests/th/T5700.stderr +++ b/testsuite/tests/th/T5700.stderr @@ -3,4 +3,4 @@ T5700.hs:8:3-9: Splicing declarations ======> instance C D where {-# INLINE inlinable #-} - inlinable _ = GHC.Tuple.() + inlinable _ = () diff --git a/testsuite/tests/th/T7064.stdout b/testsuite/tests/th/T7064.stdout index 63c3125972..d9790f79e9 100644 --- a/testsuite/tests/th/T7064.stdout +++ b/testsuite/tests/th/T7064.stdout @@ -13,8 +13,8 @@ g3_0 x_1 = 3 GHC.Types.Int -> GHC.Types.Int #-} data T_0 a_1 = T_2 a_1 instance GHC.Classes.Eq a_0 => GHC.Classes.Eq (T_1 a_0) - where (GHC.Classes.==) (T_2 x_3) (T_2 y_4) = x_3 GHC.Classes.== y_4 - {-# SPECIALISE instance GHC.Classes.Eq (T_1 GHC.Types.Int) #-} + where {-# SPECIALISE instance GHC.Classes.Eq (T_1 GHC.Types.Int) #-} + (GHC.Classes.==) (T_2 x_3) (T_2 y_4) = x_3 GHC.Classes.== y_4 {-# RULES "rule1" GHC.Real.fromIntegral = GHC.Base.id :: a_0 -> a_0 #-} diff --git a/testsuite/tests/th/T7276.stderr b/testsuite/tests/th/T7276.stderr index 93c9a0c835..4fa2a3c4c9 100644 --- a/testsuite/tests/th/T7276.stderr +++ b/testsuite/tests/th/T7276.stderr @@ -2,7 +2,7 @@ T7276.hs:6:8: error: • Couldn't match type ‘[Language.Haskell.TH.Syntax.Dec]’ with ‘Language.Haskell.TH.Syntax.Exp’ - Expected type: Language.Haskell.TH.Lib.ExpQ - Actual type: Language.Haskell.TH.Lib.DecsQ + Expected type: Language.Haskell.TH.Lib.Internal.ExpQ + Actual type: Language.Haskell.TH.Lib.Internal.DecsQ • In the expression: [d| y = 3 |] In the untyped splice: $([d| y = 3 |]) diff --git a/testsuite/tests/th/T8031.hs b/testsuite/tests/th/T8031.hs index 9f06c06ed6..08081ed6fd 100644 --- a/testsuite/tests/th/T8031.hs +++ b/testsuite/tests/th/T8031.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE TemplateHaskell, RankNTypes, TypeOperators, TypeInType, +{-# LANGUAGE TemplateHaskell, RankNTypes, TypeOperators, DataKinds, PolyKinds, GADTs #-} module T8031 where @@ -6,7 +6,7 @@ module T8031 where import Data.Proxy import Data.Kind -data SList :: [k] -> * where +data SList :: [k] -> Type where SCons :: Proxy h -> Proxy t -> SList (h ': t) $( [d| foo :: forall (a :: k). Proxy a diff --git a/testsuite/tests/th/T8953.stderr b/testsuite/tests/th/T8953.stderr index c18589d69c..3dad41244b 100644 --- a/testsuite/tests/th/T8953.stderr +++ b/testsuite/tests/th/T8953.stderr @@ -1,6 +1,6 @@ type family T8953.Poly (a_0 :: k_1) :: * type instance T8953.Poly (x_2 :: GHC.Types.Bool) = GHC.Types.Int -type instance T8953.Poly (x_3 :: GHC.Base.Maybe k_4) = GHC.Types.Double +type instance T8953.Poly (x_3 :: GHC.Maybe.Maybe k_4) = GHC.Types.Double type family T8953.Silly :: k_0 -> * type instance T8953.Silly = (Data.Proxy.Proxy :: * -> *) type instance T8953.Silly = (Data.Proxy.Proxy :: (* -> *) -> *) @@ -11,9 +11,9 @@ class T8953.PC (a_0 :: k_1) instance T8953.PC (a_2 :: *) instance T8953.PC (Data.Proxy.Proxy :: (k_3 -> *) -> *) type family T8953.F (a_0 :: *) :: k_1 -type instance T8953.F GHC.Types.Char = (T8953.G (T8953.T1 :: * -> - (* -> *) -> *) - GHC.Types.Bool :: (* -> *) -> *) +type instance T8953.F GHC.Types.Char = T8953.G (T8953.T1 :: * -> + (* -> *) -> *) + GHC.Types.Bool type family T8953.G (a_0 :: k_1) :: k_1 type instance T8953.G (T8953.T1 :: k1_2 -> k2_3 -> *) = (T8953.T2 :: k1_2 -> k2_3 -> *) diff --git a/testsuite/tests/th/T9064.stderr b/testsuite/tests/th/T9064.stderr index f118e202ad..c7f3df187c 100644 --- a/testsuite/tests/th/T9064.stderr +++ b/testsuite/tests/th/T9064.stderr @@ -1,5 +1,4 @@ class T9064.C (a_0 :: *) - where T9064.foo :: forall (a_0 :: *) . T9064.C a_0 => - a_0 -> GHC.Base.String + where T9064.foo :: a_0 -> GHC.Base.String default T9064.foo :: GHC.Show.Show a_0 => a_0 -> GHC.Base.String instance T9064.C T9064.Bar diff --git a/testsuite/tests/th/T9693.script b/testsuite/tests/th/T9693.script new file mode 100644 index 0000000000..99643e7821 --- /dev/null +++ b/testsuite/tests/th/T9693.script @@ -0,0 +1,7 @@ +System.Directory.copyFile "T9693_initial.hs" "T9693.hs" +System.IO.hPutStrLn System.IO.stderr "Loading with T9693_initial.hs" +:load T9693_main.hs +System.Directory.copyFile "T9693_modified.hs" "T9693.hs" +System.IO.hPutStrLn System.IO.stderr "Reloading with T9693_modified.hs" +:reload +System.Directory.removeFile "T9693.hs" diff --git a/testsuite/tests/th/T9693_initial.hs b/testsuite/tests/th/T9693_initial.hs new file mode 100644 index 0000000000..b646f0e607 --- /dev/null +++ b/testsuite/tests/th/T9693_initial.hs @@ -0,0 +1,9 @@ +module T9693 where +import Language.Haskell.TH + +stuff = do + -- let x = mkName "X" + x <- newName "X" + sequence $ [dataD (return []) x [] Nothing [ + normalC x [] + ] []] diff --git a/testsuite/tests/th/T9693_main.hs b/testsuite/tests/th/T9693_main.hs new file mode 100644 index 0000000000..71e7c9a3c7 --- /dev/null +++ b/testsuite/tests/th/T9693_main.hs @@ -0,0 +1,4 @@ +{-# LANGUAGE TemplateHaskell #-} +import T9693 + +stuff diff --git a/testsuite/tests/th/T9693_modified.hs b/testsuite/tests/th/T9693_modified.hs new file mode 100644 index 0000000000..cab2c04d9f --- /dev/null +++ b/testsuite/tests/th/T9693_modified.hs @@ -0,0 +1,9 @@ +module T9693 where +import Language.Haskell.TH + +stuff = do + let x = mkName "X" + -- x <- newName "X" + sequence $ [dataD (return []) x [] Nothing [ + normalC x [] + ] []] diff --git a/testsuite/tests/th/TH_PromotedList.stderr b/testsuite/tests/th/TH_PromotedList.stderr index 8a6422f6ec..fde888ff88 100644 --- a/testsuite/tests/th/TH_PromotedList.stderr +++ b/testsuite/tests/th/TH_PromotedList.stderr @@ -1,3 +1,3 @@ -TH_PromotedList.hs:11:3: Warning: - (':) GHC.Types.Int ((':) GHC.Types.Bool '[]) +TH_PromotedList.hs:11:3: warning: + '(:) GHC.Types.Int ('(:) GHC.Types.Bool '[]) diff --git a/testsuite/tests/th/TH_PromotedTuple.stderr b/testsuite/tests/th/TH_PromotedTuple.stderr index 9619d52f51..92792a361d 100644 --- a/testsuite/tests/th/TH_PromotedTuple.stderr +++ b/testsuite/tests/th/TH_PromotedTuple.stderr @@ -3,7 +3,7 @@ TH_PromotedTuple.hs:(14,32)-(16,43): Splicing type reportWarning (show ty) return ty ======> - '(Int, False) + '(Int, 'False) -TH_PromotedTuple.hs:14:32: Warning: +TH_PromotedTuple.hs:14:32: warning: AppT (AppT (PromotedTupleT 2) (ConT GHC.Types.Int)) (PromotedT GHC.Types.False) diff --git a/testsuite/tests/th/TH_RichKinds2.hs b/testsuite/tests/th/TH_RichKinds2.hs index ab3e107d0f..9ac13a157b 100644 --- a/testsuite/tests/th/TH_RichKinds2.hs +++ b/testsuite/tests/th/TH_RichKinds2.hs @@ -8,6 +8,7 @@ module TH_RichKinds2 where +import qualified Data.Kind as K import Data.Char import Data.List import Language.Haskell.TH @@ -32,7 +33,7 @@ $( let fixKs :: String -> String -- need to remove TH renaming index from k vari if length index == 0 then s else prefix ++ "0" ++ (fixKs rest) in - do decls <- [d| data SMaybe :: (k -> *) -> (Maybe k) -> * where + do decls <- [d| data SMaybe :: (k -> K.Type) -> (Maybe k) -> K.Type where SNothing :: SMaybe s 'Nothing SJust :: s a -> SMaybe s ('Just a) @@ -42,7 +43,7 @@ $( let fixKs :: String -> String -- need to remove TH renaming index from k vari reportWarning (fixKs (pprint decls)) return decls ) -data SBool :: Bool -> * where +data SBool :: Bool -> K.Type where SFalse :: SBool 'False STrue :: SBool 'True diff --git a/testsuite/tests/th/TH_RichKinds2.stderr b/testsuite/tests/th/TH_RichKinds2.stderr index 11829296e0..a0b29a15e3 100644 --- a/testsuite/tests/th/TH_RichKinds2.stderr +++ b/testsuite/tests/th/TH_RichKinds2.stderr @@ -1,9 +1,10 @@ -TH_RichKinds2.hs:24:4: warning: - data SMaybe_0 :: (k_0 -> *) -> GHC.Base.Maybe k_0 -> * where - SNothing_2 :: SMaybe_0 s_3 'GHC.Base.Nothing - SJust_4 :: (s_5 a_6) -> SMaybe_0 s_5 ('GHC.Base.Just a_6) +TH_RichKinds2.hs:25:4: warning: + data SMaybe_0 :: (k_0 -> *) -> GHC.Maybe.Maybe k_0 -> * where + SNothing_2 :: SMaybe_0 s_3 'GHC.Maybe.Nothing + SJust_4 :: (s_5 a_6) -> SMaybe_0 s_5 ('GHC.Maybe.Just a_6) type instance TH_RichKinds2.Map f_7 '[] = '[] type instance TH_RichKinds2.Map f_8 - ('GHC.Types.: h_9 t_10) = 'GHC.Types.: (f_8 h_9) - (TH_RichKinds2.Map f_8 t_10) + ('(GHC.Types.:) h_9 t_10) = '(GHC.Types.:) (f_8 h_9) + (TH_RichKinds2.Map f_8 + t_10) diff --git a/testsuite/tests/th/TH_Roles2.stderr b/testsuite/tests/th/TH_Roles2.stderr index 8d52da408c..a94a52d4ec 100644 --- a/testsuite/tests/th/TH_Roles2.stderr +++ b/testsuite/tests/th/TH_Roles2.stderr @@ -4,9 +4,9 @@ TYPE CONSTRUCTORS data T (a :: k) COERCION AXIOMS Dependent modules: [] -Dependent packages: [array-0.5.1.2, base-4.10.0.0, deepseq-1.4.3.0, - ghc-boot-th-8.1, ghc-prim-0.5.0.0, integer-gmp-1.0.0.1, - pretty-1.1.3.3, template-haskell-2.12.0.0] +Dependent packages: [array-0.5.2.0, base-4.11.0.0, deepseq-1.4.3.0, + ghc-boot-th-8.3, ghc-prim-0.5.2.1, integer-gmp-1.0.1.0, + pretty-1.1.3.5, template-haskell-2.14.0.0] ==================== Typechecker ==================== TH_Roles2.$tcT @@ -17,8 +17,8 @@ TH_Roles2.$tcT (GHC.Types.TrNameS "T"#) 1 $krep -$krep [InlPrag=[~]] = GHC.Types.KindRepVar 0 -$krep [InlPrag=[~]] +$krep [InlPrag=NOUSERINLINE[~]] = GHC.Types.KindRepVar 0 +$krep [InlPrag=NOUSERINLINE[~]] = GHC.Types.KindRepFun $krep GHC.Types.krep$* TH_Roles2.$trModule = GHC.Types.Module diff --git a/testsuite/tests/th/TH_TyInstWhere1.stderr b/testsuite/tests/th/TH_TyInstWhere1.stderr index 971b7eed24..0d07db83d1 100644 --- a/testsuite/tests/th/TH_TyInstWhere1.stderr +++ b/testsuite/tests/th/TH_TyInstWhere1.stderr @@ -4,5 +4,5 @@ TH_TyInstWhere1.hs:(5,3)-(7,24): Splicing declarations F a b = False |] ======> type family F (a :: k) (b :: k) :: Bool where - F a a = True - F a b = False + F a a = 'True + F a b = 'False diff --git a/testsuite/tests/th/TH_foreignInterruptible.stderr b/testsuite/tests/th/TH_foreignInterruptible.stderr index 7131eeee71..4afc38aab1 100644 --- a/testsuite/tests/th/TH_foreignInterruptible.stderr +++ b/testsuite/tests/th/TH_foreignInterruptible.stderr @@ -8,4 +8,4 @@ TH_foreignInterruptible.hs:8:3-100: Splicing declarations (mkName "foo") (AppT (ConT ''Ptr) (ConT ''())))] ======> - foreign import ccall interruptible "&" foo :: Ptr GHC.Tuple.() + foreign import ccall interruptible "&" foo :: Ptr () diff --git a/testsuite/tests/th/TH_implicitParams.hs b/testsuite/tests/th/TH_implicitParams.hs new file mode 100644 index 0000000000..eb948b98ed --- /dev/null +++ b/testsuite/tests/th/TH_implicitParams.hs @@ -0,0 +1,20 @@ +{-# LANGUAGE ImplicitParams #-} +import Language.Haskell.TH +import Language.Haskell.TH.Syntax + +funcToReify :: (?z :: Int) => Int +funcToReify = ?z + +$( [d| + f :: (?x :: Int) => Int + f = let ?y = 2 in ?x + ?y |] ) + +main = do + putStrLn $(lift . pprint =<< reify 'funcToReify) + print (let ?x = 3 in f) + print $( [| let ?x = 1 in ?x |] ) + print $(letE [implicitParamBindD "y" (lift (2 :: Int))] + (implicitParamVarE "y") ) + putStrLn $( lift . pprint =<< [d| + f :: (?x :: Int) => Int + f = let ?y = 2 in ?x + ?y |] ) diff --git a/testsuite/tests/th/TH_implicitParams.stdout b/testsuite/tests/th/TH_implicitParams.stdout new file mode 100644 index 0000000000..571d2e74fe --- /dev/null +++ b/testsuite/tests/th/TH_implicitParams.stdout @@ -0,0 +1,8 @@ +Main.funcToReify :: GHC.Classes.IP "z" GHC.Types.Int => + GHC.Types.Int +5 +1 +2 +f_0 :: (?x :: GHC.Types.Int) => GHC.Types.Int +f_0 = let ?y = 2 + in ?x GHC.Num.+ ?y diff --git a/testsuite/tests/th/TH_implicitParamsErr1.hs b/testsuite/tests/th/TH_implicitParamsErr1.hs new file mode 100644 index 0000000000..56cf285c59 --- /dev/null +++ b/testsuite/tests/th/TH_implicitParamsErr1.hs @@ -0,0 +1,5 @@ +{-# LANGUAGE ImplicitParams #-} +{-# LANGUAGE TemplateHaskell #-} +import Language.Haskell.TH + +$(fmap (:[]) (implicitParamBindD "x" [e| 1 |])) diff --git a/testsuite/tests/th/TH_implicitParamsErr1.stderr b/testsuite/tests/th/TH_implicitParamsErr1.stderr new file mode 100644 index 0000000000..82324810ad --- /dev/null +++ b/testsuite/tests/th/TH_implicitParamsErr1.stderr @@ -0,0 +1,4 @@ + +TH_implicitParamsErr1.hs:5:3: error: + Implicit parameter binding only allowed in let or where + When splicing a TH declaration: ?x = 1 diff --git a/testsuite/tests/th/TH_implicitParamsErr2.hs b/testsuite/tests/th/TH_implicitParamsErr2.hs new file mode 100644 index 0000000000..5b8ad90e81 --- /dev/null +++ b/testsuite/tests/th/TH_implicitParamsErr2.hs @@ -0,0 +1,8 @@ +{-# LANGUAGE ImplicitParams #-} +{-# LANGUAGE TemplateHaskell #-} +import Language.Haskell.TH + +main = $(letE [ implicitParamBindD "x" [e| 1 |] + , funD (mkName "y") [clause [] (normalB [e| 2 |]) []] + ] + (varE (mkName "y"))) diff --git a/testsuite/tests/th/TH_implicitParamsErr2.stderr b/testsuite/tests/th/TH_implicitParamsErr2.stderr new file mode 100644 index 0000000000..f93aa55a58 --- /dev/null +++ b/testsuite/tests/th/TH_implicitParamsErr2.stderr @@ -0,0 +1,10 @@ + +TH_implicitParamsErr2.hs:5:10: error: + • Implicit parameters mixed with other bindings + When splicing a TH expression: let {?x = 1; y = 2} + in y + • In the untyped splice: + $(letE + [implicitParamBindD "x" [| 1 |], + funD (mkName "y") [clause [] (normalB [| 2 |]) []]] + (varE (mkName "y"))) diff --git a/testsuite/tests/th/TH_implicitParamsErr3.hs b/testsuite/tests/th/TH_implicitParamsErr3.hs new file mode 100644 index 0000000000..b217d60846 --- /dev/null +++ b/testsuite/tests/th/TH_implicitParamsErr3.hs @@ -0,0 +1,6 @@ +{-# LANGUAGE ImplicitParams #-} +{-# LANGUAGE TemplateHaskell #-} +import Language.Haskell.TH + +main = print $(letE [implicitParamBindD "invalid name" [e| "hi" |]] + (implicitParamVarE "invalid name")) diff --git a/testsuite/tests/th/TH_implicitParamsErr3.stderr b/testsuite/tests/th/TH_implicitParamsErr3.stderr new file mode 100644 index 0000000000..fe3bf67259 --- /dev/null +++ b/testsuite/tests/th/TH_implicitParamsErr3.stderr @@ -0,0 +1,10 @@ + +TH_implicitParamsErr3.hs:5:16: error: + • Illegal variable name: ‘invalid name’ + When splicing a TH expression: + let ?invalid name = "hi" + in ?invalid name + • In the untyped splice: + $(letE + [implicitParamBindD "invalid name" [| "hi" |]] + (implicitParamVarE "invalid name")) diff --git a/testsuite/tests/th/TH_invalid_add_top_decl.hs b/testsuite/tests/th/TH_invalid_add_top_decl.hs new file mode 100644 index 0000000000..b13d873d96 --- /dev/null +++ b/testsuite/tests/th/TH_invalid_add_top_decl.hs @@ -0,0 +1,8 @@ +{-# LANGUAGE TemplateHaskell #-} +import Language.Haskell.TH +import Language.Haskell.TH.Syntax + +$(do + invalidDecl <- valD (varP (mkName "emptyDo")) (normalB (doE [])) [] + addTopDecls [invalidDecl] + return []) diff --git a/testsuite/tests/th/TH_invalid_add_top_decl.stderr b/testsuite/tests/th/TH_invalid_add_top_decl.stderr new file mode 100644 index 0000000000..9124c2d669 --- /dev/null +++ b/testsuite/tests/th/TH_invalid_add_top_decl.stderr @@ -0,0 +1,5 @@ + +TH_invalid_add_top_decl.hs:5:3: + Error in a declaration passed to addTopDecls: + Empty stmt list in do-block + When splicing a TH declaration: emptyDo = do diff --git a/testsuite/tests/th/TH_rebindableAdo.hs b/testsuite/tests/th/TH_rebindableAdo.hs new file mode 100644 index 0000000000..ad97020e70 --- /dev/null +++ b/testsuite/tests/th/TH_rebindableAdo.hs @@ -0,0 +1,17 @@ +-- Same as T14471 but also enables RebindableSyntax, since that's a +-- tricky case. + +{-# LANGUAGE ApplicativeDo #-} +{-# LANGUAGE RebindableSyntax #-} +{-# LANGUAGE TemplateHaskell #-} + +import Language.Haskell.TH +import Prelude + +main = putStrLn $(do + expr <- [| + do x <- getLine + y <- getLine + pure (x, y) + |] + stringE (pprint expr)) diff --git a/testsuite/tests/th/TH_rebindableAdo.stdout b/testsuite/tests/th/TH_rebindableAdo.stdout new file mode 100644 index 0000000000..4fc2806dc0 --- /dev/null +++ b/testsuite/tests/th/TH_rebindableAdo.stdout @@ -0,0 +1,3 @@ +do {x_0 <- System.IO.getLine; + y_1 <- System.IO.getLine; + GHC.Base.pure (x_0, y_1)} diff --git a/testsuite/tests/th/TH_recursiveDo.hs b/testsuite/tests/th/TH_recursiveDo.hs new file mode 100644 index 0000000000..f193cf7088 --- /dev/null +++ b/testsuite/tests/th/TH_recursiveDo.hs @@ -0,0 +1,18 @@ +{-# LANGUAGE RecursiveDo #-} +import Data.IORef +import Language.Haskell.TH +import Language.Haskell.TH.Syntax +import TH_recursiveDoImport + +main = testRec >> testMdo + +testRec = do + putStrLn $(lift . pprint =<< recIO) + -- Test that we got the expected structure. + SelfRef r1 <- $(recIO) + r2 <- readIORef r1 + SelfRef r1' <- readIORef r2 + print (r1 == r1') + +testMdo = + putStrLn $(lift . pprint =<< mdoIO) diff --git a/testsuite/tests/th/TH_recursiveDo.stdout b/testsuite/tests/th/TH_recursiveDo.stdout new file mode 100644 index 0000000000..5508b5dcdc --- /dev/null +++ b/testsuite/tests/th/TH_recursiveDo.stdout @@ -0,0 +1,7 @@ +do {rec {r1_0 <- GHC.IORef.newIORef r2_1; + r2_1 <- GHC.IORef.newIORef (TH_recursiveDoImport.SelfRef r1_0)}; + GHC.IORef.readIORef r2_1} +True +mdo {rec {r1_0 <- GHC.Base.return r2_1; + r2_1 <- GHC.Base.return (GHC.Base.const 1 r1_0)}; + GHC.Base.return r1_0} diff --git a/testsuite/tests/th/TH_recursiveDoImport.hs b/testsuite/tests/th/TH_recursiveDoImport.hs new file mode 100644 index 0000000000..519987863f --- /dev/null +++ b/testsuite/tests/th/TH_recursiveDoImport.hs @@ -0,0 +1,23 @@ +{-# LANGUAGE RecursiveDo #-} +module TH_recursiveDoImport where +import Data.IORef +import Language.Haskell.TH + +data SelfRef = SelfRef (IORef (IORef SelfRef)) + +recIO :: ExpQ +recIO = [e| + do rec r1 <- newIORef r2 + r2 <- newIORef (SelfRef r1) + readIORef r2 |] + +mdoIO :: ExpQ +mdoIO = [e| + mdo r1 <- return r2 + r2 <- return (const 1 r1) + return r1 |] + +emptyRecIO :: ExpQ +emptyRecIO = [e| + do rec {} + return () |] diff --git a/testsuite/tests/th/TH_reifyDecl1.stderr b/testsuite/tests/th/TH_reifyDecl1.stderr index e65558774a..b18089b3a0 100644 --- a/testsuite/tests/th/TH_reifyDecl1.stderr +++ b/testsuite/tests/th/TH_reifyDecl1.stderr @@ -9,15 +9,14 @@ data TH_reifyDecl1.Tree (a_0 :: *) | (TH_reifyDecl1.Tree a_0) TH_reifyDecl1.:+: (TH_reifyDecl1.Tree a_0) type TH_reifyDecl1.IntList = [GHC.Types.Int] newtype TH_reifyDecl1.Length = TH_reifyDecl1.Length GHC.Types.Int -Constructor from TH_reifyDecl1.Tree: TH_reifyDecl1.Leaf :: forall (a_0 :: *) . TH_reifyDecl1.Tree a_0 +Constructor from TH_reifyDecl1.Tree: TH_reifyDecl1.Leaf :: forall (a_0 :: *) . + TH_reifyDecl1.Tree a_0 Class op from TH_reifyDecl1.C1: TH_reifyDecl1.m1 :: forall (a_0 :: *) . TH_reifyDecl1.C1 a_0 => - a_0 -> GHC.Types.Int + a_0 -> GHC.Types.Int class TH_reifyDecl1.C1 (a_0 :: *) - where TH_reifyDecl1.m1 :: forall (a_0 :: *) . TH_reifyDecl1.C1 a_0 => - a_0 -> GHC.Types.Int + where TH_reifyDecl1.m1 :: a_0 -> GHC.Types.Int class TH_reifyDecl1.C2 (a_0 :: *) - where TH_reifyDecl1.m2 :: forall (a_0 :: *) . TH_reifyDecl1.C2 a_0 => - a_0 -> GHC.Types.Int + where TH_reifyDecl1.m2 :: a_0 -> GHC.Types.Int instance TH_reifyDecl1.C2 GHC.Types.Int class TH_reifyDecl1.C3 (a_0 :: *) where type TH_reifyDecl1.AT1 (a_0 :: *) :: * diff --git a/testsuite/tests/th/TH_reifyDecl2.stderr b/testsuite/tests/th/TH_reifyDecl2.stderr index 64436f811e..2e7650bc23 100644 --- a/testsuite/tests/th/TH_reifyDecl2.stderr +++ b/testsuite/tests/th/TH_reifyDecl2.stderr @@ -1,2 +1,2 @@ -data GHC.Base.Maybe (a_0 :: *) - = GHC.Base.Nothing | GHC.Base.Just a_0 +data GHC.Maybe.Maybe (a_0 :: *) + = GHC.Maybe.Nothing | GHC.Maybe.Just a_0 diff --git a/testsuite/tests/th/TH_repGuard.stderr b/testsuite/tests/th/TH_repGuard.stderr index bbef7eed59..ce93ab937d 100644 --- a/testsuite/tests/th/TH_repGuard.stderr +++ b/testsuite/tests/th/TH_repGuard.stderr @@ -1,7 +1,7 @@ foo_0 :: GHC.Types.Int -> GHC.Types.Int foo_0 x_1 | x_1 GHC.Classes.== 5 = 6 foo_0 x_2 = 7 -bar_0 :: GHC.Base.Maybe GHC.Types.Int -> GHC.Types.Int -bar_0 x_1 | GHC.Base.Just y_2 <- x_1 +bar_0 :: GHC.Maybe.Maybe GHC.Types.Int -> GHC.Types.Int +bar_0 x_1 | GHC.Maybe.Just y_2 <- x_1 = y_2 bar_0 _ = 9 diff --git a/testsuite/tests/th/TH_unresolvedInfix.hs b/testsuite/tests/th/TH_unresolvedInfix.hs index 49f283bcd8..aa684f7f23 100644 --- a/testsuite/tests/th/TH_unresolvedInfix.hs +++ b/testsuite/tests/th/TH_unresolvedInfix.hs @@ -1,4 +1,5 @@ {-# LANGUAGE TypeOperators #-} +{-# LANGUAGE NoStarIsType #-} {-# LANGUAGE QuasiQuotes #-} module Main where diff --git a/testsuite/tests/th/TH_unresolvedInfix_Lib.hs b/testsuite/tests/th/TH_unresolvedInfix_Lib.hs index e6ad9f027b..a88b93fc8a 100644 --- a/testsuite/tests/th/TH_unresolvedInfix_Lib.hs +++ b/testsuite/tests/th/TH_unresolvedInfix_Lib.hs @@ -1,4 +1,5 @@ {-# LANGUAGE TypeOperators #-} +{-# LANGUAGE NoStarIsType #-} module TH_unresolvedInfix_Lib where diff --git a/testsuite/tests/th/all.T b/testsuite/tests/th/all.T index f89be6e0bb..9a25591937 100644 --- a/testsuite/tests/th/all.T +++ b/testsuite/tests/th/all.T @@ -305,7 +305,7 @@ test('TH_Lift', normal, compile, ['-v0']) test('T10047', only_ways(['ghci']), ghci_script, ['T10047.script']) test('T10019', only_ways(['ghci']), ghci_script, ['T10019.script']) test('T10267', [], multimod_compile_fail, - ['T10267', '-dsuppress-uniques -v0 ' + config.ghc_th_way_flags]) + ['T10267', '-fno-max-valid-hole-fits -dsuppress-uniques -v0 ' + config.ghc_th_way_flags]) test('T10279', normal, compile_fail, ['-v0']) test('T10306', normal, compile, ['-v0']) test('T10596', normal, compile, ['-v0']) @@ -350,6 +350,7 @@ test('T9022', normal, compile_and_run, ['-v0']) test('T11145', normal, compile_fail, ['-v0 -dsuppress-uniques']) test('T11463', normal, compile_and_run, ['-v0 -dsuppress-uniques']) test('T11680', normal, compile_fail, ['-v0']) +test('T11721_TH', normal, compile, ['-v0']) test('T11809', normal, compile, ['-v0']) test('T11797', normal, compile, ['-v0 -dsuppress-uniques']) test('T11941', normal, compile_fail, ['-v0']) @@ -359,6 +360,7 @@ test('T11629', normal, compile, ['-v0']) test('T8761', normal, compile, ['-v0 -ddump-splices -dsuppress-uniques']) test('T12130', [], multimod_compile, ['T12130', '-v0 ' + config.ghc_th_way_flags]) +test('T12387', normal, compile_fail, ['-v0']) test('T12403', omit_ways(['ghci']), compile_and_run, ['-v0 -ddump-splices -dsuppress-uniques']) test('T12407', omit_ways(['ghci']), compile, ['-v0']) @@ -381,12 +383,54 @@ test('T13018', normal, compile, ['-v0']) test('T13123', normal, compile, ['-v0']) test('T13098', normal, compile, ['-v0']) test('T11046', normal, multimod_compile, ['T11046','-v0']) -test('T13366', normal, compile_and_run, ['-lstdc++ -v0']) +test('T13366', expect_broken_for(13366, ['ghci']), compile_and_run, ['-lstdc++ -v0']) test('T13473', normal, multimod_compile_and_run, ['T13473.hs', '-v0 ' + config.ghc_th_way_flags]) test('T13587', expect_broken(13587), compile_and_run, ['-v0']) test('T13618', normal, compile_and_run, ['-v0']) -test('T13642', normal, compile_fail, ['-v0']) +test('T13642', normal, compile, ['-v0']) test('T13781', normal, compile, ['-v0']) test('T13782', normal, compile, ['']) +test('T13837', normal, compile_fail, ['-v0 -dsuppress-uniques']) test('T13856', normal, compile, ['-v0 -ddump-splices -dsuppress-uniques']) +test('T13885', normal, compile_and_run, ['-v0']) +test('T13887', normal, compile_and_run, ['-v0']) +test('T13968', normal, compile_fail, ['-v0']) +test('T14204', normal, compile_fail, ['-v0']) +test('T14060', normal, compile_and_run, ['-v0']) +test('T14646', normal, compile, ['-v0 -ddump-splices -dsuppress-uniques']) +test('T14681', normal, compile, ['-v0 -ddump-splices -dsuppress-uniques']) +test('T14817', normal, compile, ['-v0 -ddump-splices -dsuppress-uniques']) +test('T14843', normal, compile, ['-v0']) +test('T13776', normal, compile, ['-ddump-splices -v0']) +test('T14869', normal, compile, + ['-v0 -ddump-splices -dsuppress-uniques ' + config.ghc_th_way_flags]) +test('T14888', normal, compile, + ['-v0 -ddump-splices -dsuppress-uniques ' + config.ghc_th_way_flags]) +# There is a phasing issue in the ghci way which prevents us from being +# able to compile and link the foreign file while compiling the haskell module. +test('T14298', expect_broken_for(15161, ['ghci']), compile_and_run, ['-v0']) +test('T14875', normal, compile, ['-v0 -ddump-splices -dsuppress-uniques']) +test('T14885a', normal, compile, ['']) +test('T14885b', normal, compile, ['']) +test('T14885c', normal, compile, ['']) +test('T15243', normal, compile, ['-dsuppress-uniques']) +test('T15321', normal, compile_fail, ['']) +test('T15324', normal, compile, ['-v0 -ddump-splices -dsuppress-uniques']) +test('T15331', normal, compile, ['-v0 -ddump-splices -dsuppress-uniques']) +test('T15365', normal, compile, ['-v0 -ddump-splices -dsuppress-uniques']) +# Note: T9693 should be only_ways(['ghci']) once it's fixed. +test('T9693', expect_broken(9693), ghci_script, ['T9693.script']) +test('T14471', normal, compile, ['']) +test('TH_rebindableAdo', normal, compile, ['']) +test('T14627', normal, compile_fail, ['']) +test('TH_invalid_add_top_decl', normal, compile_fail, ['']) +test('T15550', normal, compile, ['-v0 -ddump-splices -dsuppress-uniques']) +test('T15502', normal, compile, ['-v0 -ddump-splices -dsuppress-uniques']) +test('T15518', normal, compile, ['-v0 -ddump-splices -dsuppress-uniques']) +test('T15572', normal, compile, ['-v0 -ddump-splices -dsuppress-uniques']) +test('TH_implicitParams', normal, compile_and_run, ['-v0 -dsuppress-uniques']) +test('TH_implicitParamsErr1', normal, compile_fail, ['-v0 -dsuppress-uniques']) +test('TH_implicitParamsErr2', normal, compile_fail, ['-v0 -dsuppress-uniques']) +test('TH_implicitParamsErr3', normal, compile_fail, ['-v0 -dsuppress-uniques']) +test('TH_recursiveDo', normal, compile_and_run, ['-v0 -dsuppress-uniques']) diff --git a/testsuite/tests/th/should_compile/T13949/all.T b/testsuite/tests/th/should_compile/T13949/all.T index 9975e58bf3..edd3fe5c9f 100644 --- a/testsuite/tests/th/should_compile/T13949/all.T +++ b/testsuite/tests/th/should_compile/T13949/all.T @@ -1,2 +1,12 @@ -test('T13949', extra_files(['ASCII.hs', 'PatternGenerator.hs', 'These.hs', 'Tree.hs']), - multimod_compile, ['ASCII PatternGenerator These Tree', '-fno-code -v0'])
\ No newline at end of file +# we omit profasm because it doesn't bring much to the table but +# introduces its share of complexity, as the test as it is fails with +# profasm: +# ASCII.hs:1:1: fatal: +# Cannot load -prof objects when GHC is built with -dynamic +# To fix this, either: +# (1) Use -fexternal-interpreter, or +# (2) Build the program twice: once with -dynamic, and then +# with -prof using -osuf to set a different object file suffix. +test('T13949', [extra_files(['ASCII.hs', 'PatternGenerator.hs', 'These.hs', 'Tree.hs']), req_interp, + omit_ways(['profasm'])], + multimod_compile, ['ASCII PatternGenerator These Tree', '-fno-code -v0']) diff --git a/testsuite/tests/th/should_compile/T8025/all.T b/testsuite/tests/th/should_compile/T8025/all.T index 81e6d5e5fd..4cdf19cae8 100644 --- a/testsuite/tests/th/should_compile/T8025/all.T +++ b/testsuite/tests/th/should_compile/T8025/all.T @@ -1,2 +1,9 @@ -test('T8025', extra_files(['A.hs', 'B.hs']), multimod_compile, - ['A B', '-fno-code -v0'])
\ No newline at end of file +# we omit profasm because it fails with: +# B.hs:5:5: fatal: +# Cannot load -prof objects when GHC is built with -dynamic +# To fix this, either: +# (1) Use -fexternal-interpreter, or +# (2) Build the program twice: once with -dynamic, and then +# with -prof using -osuf to set a different object file suffix. +test('T8025', [extra_files(['A.hs', 'B.hs']), omit_ways(['profasm']), req_interp], + multimod_compile, ['A B', '-fno-code -v0']) diff --git a/testsuite/tests/typecheck/T13168/Makefile b/testsuite/tests/typecheck/T13168/Makefile index 4dc9d7be28..3cae52a542 100644 --- a/testsuite/tests/typecheck/T13168/Makefile +++ b/testsuite/tests/typecheck/T13168/Makefile @@ -8,7 +8,7 @@ CONFIGURE=$(SETUP) configure --with-ghc='$(TEST_HC)' --ghc-options='$(TEST_HC_OP T13168: clean $(MAKE) -s --no-print-directory clean '$(GHC_PKG)' init tmp.d - '$(TEST_HC)' -v0 --make Setup + '$(TEST_HC)' $(TEST_HC_OPTS) -v0 --make Setup cd package1 && $(CONFIGURE) && $(SETUP) build && $(SETUP) copy && $(SETUP) register cd package2 && $(CONFIGURE) && $(SETUP) build && $(SETUP) copy && $(SETUP) register diff --git a/testsuite/tests/typecheck/T13168/all.T b/testsuite/tests/typecheck/T13168/all.T index 43a5e1b7fd..2ca1d0b186 100644 --- a/testsuite/tests/typecheck/T13168/all.T +++ b/testsuite/tests/typecheck/T13168/all.T @@ -1,4 +1,5 @@ test('T13168', - extra_files(['package1', 'package2', 'Setup.hs']), + [extra_files(['package1', 'package2', 'Setup.hs']), + when(opsys('mingw32'), expect_broken(14276))], run_command, ['$MAKE -s --no-print-directory T13168']) diff --git a/testsuite/tests/typecheck/bug1465/Makefile b/testsuite/tests/typecheck/bug1465/Makefile index 706b26bbb1..d45fb3c1ee 100644 --- a/testsuite/tests/typecheck/bug1465/Makefile +++ b/testsuite/tests/typecheck/bug1465/Makefile @@ -27,7 +27,7 @@ prep: '$(TEST_HC)' $(TEST_HC_OPTS) -package-db $(LOCAL_PKGCONF) -c -package $(PKG)-2.0 B2.hs prep.%: - cd $* && '$(TEST_HC)' -v0 --make -o setup Setup.hs + cd $* && '$(TEST_HC)' $(TEST_HC_OPTS) -v0 --make -o setup Setup.hs cd $* && ./setup configure $(CABAL_MINIMAL_BUILD) -v0 --with-compiler='$(TEST_HC)' --with-ghc-pkg='$(GHC_PKG)' --ghc-options='$(TEST_HC_OPTS)' --package-db ../$(LOCAL_PKGCONF) cd $* && ./setup build -v0 cd $* && ./setup register -v0 --inplace diff --git a/testsuite/tests/typecheck/should_compile/ExPatFail.stderr b/testsuite/tests/typecheck/should_compile/ExPatFail.stderr index 6cc24fcaf6..e38c32b595 100644 --- a/testsuite/tests/typecheck/should_compile/ExPatFail.stderr +++ b/testsuite/tests/typecheck/should_compile/ExPatFail.stderr @@ -1,12 +1,14 @@ ExPatFail.hs:12:15: error: • Couldn't match expected type ‘p’ with actual type ‘a’ - because type variable ‘a’ would escape its scope - This (rigid, skolem) type variable is bound by + ‘a’ is a rigid type variable bound by a pattern with constructor: MkT :: forall a. Integral a => a -> Int -> T, in a pattern binding at ExPatFail.hs:12:11-17 + ‘p’ is a rigid type variable bound by + the inferred type of f :: T -> p + at ExPatFail.hs:(12,1)-(13,10) • In the pattern: MkT y _ In a pattern binding: MkT y _ = x In the expression: let MkT y _ = x in y diff --git a/testsuite/tests/typecheck/should_compile/Makefile b/testsuite/tests/typecheck/should_compile/Makefile index fc908998f9..ac18b2f4b3 100644 --- a/testsuite/tests/typecheck/should_compile/Makefile +++ b/testsuite/tests/typecheck/should_compile/Makefile @@ -2,6 +2,14 @@ TOP=../../.. include $(TOP)/mk/boilerplate.mk include $(TOP)/mk/test.mk +T14434: + '$(TEST_HC)' $(TEST_HC_OPTS) -c T14434.hs -ddump-simpl | grep toStringX + # Expecting toStringX = toString, not discarding argument + +T14774: + '$(TEST_HC)' $(TEST_HC_OPTS) -c T14774.hs -ddump-simpl | grep p1D + # Expecting no superclass selections to actually happen + tc170: $(RM) Tc170_Aux.hi Tc170_Aux.o tc170.hi tc170.o '$(TEST_HC)' $(TEST_HC_OPTS) -c Tc170_Aux.hs @@ -62,3 +70,8 @@ T13585: '$(TEST_HC)' $(TEST_HC_OPTS) -c T13585a.hs -O '$(TEST_HC)' $(TEST_HC_OPTS) -c T13585b.hs -O '$(TEST_HC)' $(TEST_HC_OPTS) -c T13585.hs -O + +T14934: + $(RM) -f T14934a.o T14934a.hi T14934.o T14934.hi + '$(TEST_HC)' $(TEST_HC_OPTS) -c T14934a.hs -O + '$(TEST_HC)' $(TEST_HC_OPTS) -c T14934.hs -O diff --git a/testsuite/tests/typecheck/should_compile/MissingExportList01.hs b/testsuite/tests/typecheck/should_compile/MissingExportList01.hs new file mode 100644 index 0000000000..62b9509bab --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/MissingExportList01.hs @@ -0,0 +1,5 @@ +{-# OPTIONS_GHC -Werror -fwarn-missing-export-lists #-} +module ShouldCompile (foo) where + +foo :: String +foo = "foo" diff --git a/testsuite/tests/typecheck/should_compile/MissingExportList02.hs b/testsuite/tests/typecheck/should_compile/MissingExportList02.hs new file mode 100644 index 0000000000..15c31b93c3 --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/MissingExportList02.hs @@ -0,0 +1,5 @@ +{-# OPTIONS_GHC -Werror -fwarn-missing-export-lists #-} +module ShouldCompile () where + +foo :: String +foo = "foo" diff --git a/testsuite/tests/typecheck/should_compile/SplitWD.hs b/testsuite/tests/typecheck/should_compile/SplitWD.hs new file mode 100644 index 0000000000..5281cdbf0e --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/SplitWD.hs @@ -0,0 +1,55 @@ +{-# LANGUAGE ScopedTypeVariables, TypeOperators, DataKinds, PolyKinds, + TypeFamilies, GADTs, StandaloneDeriving #-} + +module SplitWD where + +import Data.Kind ( Type ) + +data Nat = Zero | Succ Nat + +type family a + b where + Zero + b = b + Succ a + b = Succ (a + b) +infixl 6 + + +data Vec :: Type -> Nat -> Type where + VNil :: Vec a Zero + (:>) :: a -> Vec a n -> Vec a (Succ n) +infixr 5 :> + +type family (xs :: Vec a n) +++ (ys :: Vec a m) :: Vec a (n + m) where + VNil +++ ys = ys + (x :> xs) +++ ys = x :> (xs +++ ys) +infixr 5 +++ + +data Exp :: Vec Type n -> Type -> Type where + Var :: Elem xs x -> Exp xs x + +data Elem :: forall a n. Vec a n -> a -> Type where + Here :: Elem (x :> xs) x + There :: Elem xs x -> Elem (y :> xs) x + +-- | @Length xs@ is a runtime witness for how long a vector @xs@ is. +-- @LZ :: Length xs@ says that @xs@ is empty. +-- @LS len :: Length xs@ tells you that @xs@ has one more element +-- than @len@ says. +-- A term of type @Length xs@ also serves as a proxy for @xs@. +data Length :: forall a n. Vec a n -> Type where + LZ :: Length VNil + LS :: Length xs -> Length (x :> xs) + +deriving instance Show (Length xs) + +-- | Convert an expression typed in one context to one typed in a larger +-- context. Operationally, this amounts to de Bruijn index shifting. +-- As a proposition, this is the weakening lemma. +shift :: forall ts2 t ty. Exp ts2 ty -> Exp (t :> ts2) ty +shift = go LZ + where + go :: forall ts1 ty. Length ts1 -> Exp (ts1 +++ ts2) ty -> Exp (ts1 +++ t :> ts2) ty + go l_ts1 (Var v) = Var (shift_elem l_ts1 v) + + shift_elem :: Length ts1 -> Elem (ts1 +++ ts2) x + -> Elem (ts1 +++ t :> ts2) x + shift_elem = undefined + diff --git a/testsuite/tests/typecheck/should_compile/T10100.hs b/testsuite/tests/typecheck/should_compile/T10100.hs index 031be76ce2..b88803c633 100644 --- a/testsuite/tests/typecheck/should_compile/T10100.hs +++ b/testsuite/tests/typecheck/should_compile/T10100.hs @@ -2,7 +2,6 @@ {-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE UndecidableInstances #-} -{-# OPTIONS_GHC -fno-warn-redundant-constraints #-} module T10100 where diff --git a/testsuite/tests/typecheck/should_compile/T10177.hs b/testsuite/tests/typecheck/should_compile/T10177.hs index fd84396f67..43aac8afd4 100644 --- a/testsuite/tests/typecheck/should_compile/T10177.hs +++ b/testsuite/tests/typecheck/should_compile/T10177.hs @@ -1,5 +1,8 @@ {-# LANGUAGE PolyKinds #-} {-# LANGUAGE FlexibleContexts #-} +{-# OPTIONS_GHC -Wno-simplifiable-class-constraints #-} + -- This test deliberately uses a simplifiable class constraint + module T10177 where import Data.Typeable diff --git a/testsuite/tests/typecheck/should_compile/T10348.hs b/testsuite/tests/typecheck/should_compile/T10348.hs index dadb8aa7cf..d79e66b936 100644 --- a/testsuite/tests/typecheck/should_compile/T10348.hs +++ b/testsuite/tests/typecheck/should_compile/T10348.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE AutoDeriveTypeable, GADTs, DataKinds, KindSignatures, StandaloneDeriving, TypeOperators #-} +{-# LANGUAGE GADTs, DataKinds, KindSignatures, StandaloneDeriving, TypeOperators #-} module T10348 where diff --git a/testsuite/tests/typecheck/should_compile/T10432.hs b/testsuite/tests/typecheck/should_compile/T10432.hs index 7a9821e6cf..ec46f17f14 100644 --- a/testsuite/tests/typecheck/should_compile/T10432.hs +++ b/testsuite/tests/typecheck/should_compile/T10432.hs @@ -2,15 +2,16 @@ DataKinds, RankNTypes, GADTs, TypeOperators #-} module T10432 where +import Data.Kind (Type) import Data.Type.Equality data WrappedType = forall a. WrapType a; -matchReflK :: forall (a :: ka) (b :: kb) (r :: *). +matchReflK :: forall (a :: ka) (b :: kb) (r :: Type). ('WrapType a :~: 'WrapType b) -> (('WrapType a ~ 'WrapType b) => r) -> r; matchReflK Refl r = r; -matchReflK2 :: forall (a :: ka) (b :: kb) (r :: *). +matchReflK2 :: forall (a :: ka) (b :: kb) (r :: Type). ('WrapType a :~: 'WrapType b) -> r matchReflK2 x = let foo :: ('WrapType a ~ 'WrapType b) => r foo = undefined diff --git a/testsuite/tests/typecheck/should_compile/T11237.hs b/testsuite/tests/typecheck/should_compile/T11237.hs index 422aefdb67..db15a7b337 100644 --- a/testsuite/tests/typecheck/should_compile/T11237.hs +++ b/testsuite/tests/typecheck/should_compile/T11237.hs @@ -1,6 +1,6 @@ -{-# LANGUAGE TypeInType #-} +{-# LANGUAGE DataKinds, KindSignatures #-} {-# LANGUAGE GADTs #-} -module TypeInTypeBug where +module T11237 where import qualified Data.Kind diff --git a/testsuite/tests/typecheck/should_compile/T11348.hs b/testsuite/tests/typecheck/should_compile/T11348.hs index 2548dbdab7..6edc0acd3e 100644 --- a/testsuite/tests/typecheck/should_compile/T11348.hs +++ b/testsuite/tests/typecheck/should_compile/T11348.hs @@ -2,7 +2,6 @@ {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE DataKinds #-} -{-# LANGUAGE TypeInType #-} module T11348 where diff --git a/testsuite/tests/typecheck/should_compile/T11524.hs b/testsuite/tests/typecheck/should_compile/T11524.hs index d257554439..d6e2adf4f4 100644 --- a/testsuite/tests/typecheck/should_compile/T11524.hs +++ b/testsuite/tests/typecheck/should_compile/T11524.hs @@ -2,7 +2,6 @@ {-# LANGUAGE PolyKinds #-} {-# LANGUAGE ExplicitForAll #-} {-# LANGUAGE PatternSynonyms #-} -{-# LANGUAGE TypeInType #-} module T11524 where diff --git a/testsuite/tests/typecheck/should_compile/T11723.hs b/testsuite/tests/typecheck/should_compile/T11723.hs index 1933024f2e..636e40fdb0 100644 --- a/testsuite/tests/typecheck/should_compile/T11723.hs +++ b/testsuite/tests/typecheck/should_compile/T11723.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE TypeInType #-} +{-# LANGUAGE DataKinds, PolyKinds #-} module Example where import Data.Typeable diff --git a/testsuite/tests/typecheck/should_compile/T11766.hs b/testsuite/tests/typecheck/should_compile/T11766.hs new file mode 100644 index 0000000000..123dec0ad6 --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/T11766.hs @@ -0,0 +1,30 @@ +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE FunctionalDependencies #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE UndecidableInstances #-} +module T11766 where + +import Data.Maybe (isJust) + +data Wrapper a = Wrapper a deriving (Show) + +class Resolution a +instance Resolution (Wrapper a) + +class (Resolution b, Resolution d) => C a b c d | a -> b, c -> d, a d -> c, b c -> a where + cfun :: (b -> d) -> a -> c + +instance {-# OVERLAPPABLE #-} (Resolution b, Resolution d, a ~ b, c ~ d) => C a b c d where + cfun = ($) + +instance {-# OVERLAPPING #-} (C b c d e) => C (Maybe a -> b) c (Maybe a -> d) e where + cfun f b = \x -> cfun f (b x) + +foo :: Maybe a -> Wrapper Bool +foo = Wrapper . isJust + +t1 = cfun id foo $! Nothing +t2 = let f = cfun id foo in f Nothing +t3 = cfun id foo Nothing +t4 = cfun id foo $ Nothing diff --git a/testsuite/tests/typecheck/should_compile/T11811.hs b/testsuite/tests/typecheck/should_compile/T11811.hs index 16a225b4cf..a3fadb92e7 100644 --- a/testsuite/tests/typecheck/should_compile/T11811.hs +++ b/testsuite/tests/typecheck/should_compile/T11811.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE TypeInType, GADTs #-} +{-# LANGUAGE PolyKinds, GADTs #-} module T11811 where diff --git a/testsuite/tests/typecheck/should_compile/T12133.hs b/testsuite/tests/typecheck/should_compile/T12133.hs index f2502a786a..f35c51000d 100644 --- a/testsuite/tests/typecheck/should_compile/T12133.hs +++ b/testsuite/tests/typecheck/should_compile/T12133.hs @@ -11,10 +11,10 @@ module T12133 where import GHC.Classes (IP(..)) -import GHC.Exts (Constraint) +import Data.Kind (Constraint, Type) -- | From "Data.Constraint": -data Dict :: Constraint -> * where Dict :: a => Dict a +data Dict :: Constraint -> Type where Dict :: a => Dict a newtype a :- b = Sub (a => Dict b) @@ -65,4 +65,4 @@ t.hs:44:13: error: foo :: (c1, c2) :- c3 -> (c1, (IP sym ty, c2)) :- (IP sym ty, c3) (bound at t.hs:40:1) Failed, modules loaded: none. --}
\ No newline at end of file +-} diff --git a/testsuite/tests/typecheck/should_compile/T12381.hs b/testsuite/tests/typecheck/should_compile/T12381.hs index 9d4d731374..102a48321c 100644 --- a/testsuite/tests/typecheck/should_compile/T12381.hs +++ b/testsuite/tests/typecheck/should_compile/T12381.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE TypeInType, TypeFamilies #-} +{-# LANGUAGE DataKinds, PolyKinds, TypeFamilies #-} module Kinds where import GHC.Types diff --git a/testsuite/tests/typecheck/should_compile/T12734.hs b/testsuite/tests/typecheck/should_compile/T12734.hs index a3b26d5aaf..e88d21a233 100644 --- a/testsuite/tests/typecheck/should_compile/T12734.hs +++ b/testsuite/tests/typecheck/should_compile/T12734.hs @@ -20,6 +20,7 @@ module T12734 where import Prelude +import Data.Kind import Control.Applicative import Control.Monad.Fix import Control.Monad.Trans.Identity @@ -30,14 +31,14 @@ import Control.Monad.IO.Class data A data B data Net -data Type +data Ty data Layer4 t l data TermStore -- Helpers: Stack -data Stack layers (t :: * -> *) where +data Stack layers (t :: Type -> Type) where SLayer :: t l -> Stack ls t -> Stack (l ': ls) t SNull :: Stack '[] t @@ -57,28 +58,35 @@ type TermStack t layers = Stack layers (Layer4 (Expr t layers)) class Monad m => Constructor m t instance ( Monad m, expr ~ Expr t layers, Constructor m (TermStack t layers) - ) => Constructor m (Layer4 expr Type) + ) => Constructor m (Layer4 expr Ty) --- HERE IS A FUNNY BEHAVIOR: the commented line raises context reduction stack overflow -test_gr :: ( Constructor m (TermStack t layers), Inferable A layers m, Inferable B t m - , bind ~ Expr t layers --- ) => m (Expr t layers) - ) => m bind +-- HERE IS A FUNNY BEHAVIOR: the commented line raises context reduction stack +-- overflow +test_gr :: + ( Constructor m (TermStack t layers), Inferable A layers m, Inferable B t m + , bind ~ Expr t layers +-- ) => m (Expr t layers) + ) => m bind test_gr = undefined -- Explicit information about a type which could be inferred -class Monad m => Inferable (cls :: *) (t :: k) m | cls m -> t +class Monad m => Inferable (cls :: Type) (t :: k) m | cls m -> t -newtype KnownTypex (cls :: *) (t :: k) (m :: * -> *) (a :: *) = KnownTypex (IdentityT m a) deriving (Show, Functor, Monad, MonadIO, MonadFix, MonadTrans, Applicative, Alternative) +newtype KnownTyx (cls :: Type) (t :: k) (m :: Type -> Type) (a :: Type) = + KnownTyx (IdentityT m a) + deriving (Show, Functor, Monad, MonadIO, MonadFix, MonadTrans, + Applicative, Alternative) -instance {-# OVERLAPPABLE #-} (t ~ t', Monad m) => Inferable cls t (KnownTypex cls t' m) -instance {-# OVERLAPPABLE #-} (Inferable cls t n, MonadTrans m, Monad (m n)) => Inferable cls t (m n) +instance {-# OVERLAPPABLE #-} (t ~ t', Monad m) => + Inferable cls t (KnownTyx cls t' m) +instance {-# OVERLAPPABLE #-} (Inferable cls t n, MonadTrans m, Monad (m n)) => + Inferable cls t (m n) -runInferenceTx :: forall cls t m a. KnownTypex cls t m a -> m a +runInferenceTx :: forall cls t m a. KnownTyx cls t m a -> m a runInferenceTx = undefined @@ -86,7 +94,7 @@ runInferenceTx = undefined -- running it test_ghc_err :: (MonadIO m, MonadFix m) - => m (Expr Net '[Type]) + => m (Expr Net '[Ty]) test_ghc_err = runInferenceTx @B @Net - $ runInferenceTx @A @'[Type] + $ runInferenceTx @A @'[Ty] $ (test_gr) diff --git a/testsuite/tests/typecheck/should_compile/T12734a.hs b/testsuite/tests/typecheck/should_compile/T12734a.hs index 38f7307f1a..5f1da8b818 100644 --- a/testsuite/tests/typecheck/should_compile/T12734a.hs +++ b/testsuite/tests/typecheck/should_compile/T12734a.hs @@ -16,11 +16,12 @@ -- This version is shorter than T12734, and should yield a -- type error message. If things go wrong, you get --- an nfinite loop +-- an infinite loop module T12734a where import Prelude +import Data.Kind import Control.Applicative import Control.Monad.Fix import Control.Monad.Trans.Identity @@ -31,12 +32,12 @@ import Control.Monad.IO.Class data A data B data Net -data Type +data Ty data Layer4 t l data TermStore -data Stack lrs (t :: * -> *) where +data Stack lrs (t :: Type -> Type) where SLayer :: t l -> Stack ls t -> Stack (l ': ls) t SNull :: Stack '[] t @@ -44,7 +45,7 @@ instance ( Con m (t l) , Con m (Stack ls t)) => Con m (Stack (l ': ls) t) instance Monad m => Con m (Stack '[] t) instance ( expr ~ Expr t lrs - , Con m (TStk t lrs)) => Con m (Layer4 expr Type) + , Con m (TStk t lrs)) => Con m (Layer4 expr Ty) newtype Expr t lrs = Expr (TStk t lrs) @@ -63,18 +64,18 @@ test_gr :: forall m t lrs bind. test_gr = undefined -newtype KT (cls :: *) (t :: k) (m :: * -> *) (a :: *) +newtype KT (cls :: Type) (t :: k) (m :: Type -> Type) (a :: Type) = KT (IdentityT m a) -test_ghc_err :: KT A '[Type] IO (Expr Net '[Type]) +test_ghc_err :: KT A '[Ty] IO (Expr Net '[Ty]) -test_ghc_err = test_gr @(KT A '[Type] IO) @_ @'[Type] @(Expr Net '[Type]) +test_ghc_err = test_gr @(KT A '[Ty] IO) @_ @'[Ty] @(Expr Net '[Ty]) {- Works! -test_ghc_err = test_gr @(KT A '[Type] IO) +test_ghc_err = test_gr @(KT A '[Ty] IO) @Net - @'[Type] - @(Expr Net '[Type]) + @'[Ty] + @(Expr Net '[Ty]) -} {- Some notes. See comment:10 on Trac #12734 @@ -82,22 +83,22 @@ test_ghc_err = test_gr @(KT A '[Type] IO) [W] Con m (TStk t lrs) [W] Inferable A lrs m [W] bind ~ Expr t lrs -[W] m bind ~ KT A '[Type] IO (Expr Net '[Type]) +[W] m bind ~ KT A '[Ty] IO (Expr Net '[Ty]) -==> m := KT A '[Type] IO - bind := Expr Net '[Type] +==> m := KT A '[Ty] IO + bind := Expr Net '[Ty] t := Net - lrs := '[Type] + lrs := '[Ty] [W] Con m (TStk t lrs) = Con m (Stack lrs (Layer4 bind)) --> inline lrs -[W] Con m (Stack '[Type] (Layer4 bind)) +[W] Con m (Stack '[Ty] (Layer4 bind)) --> instance [W] Con m (Stack '[] bind) --> Monad m + -[W] Con m (Layer4 bind Type) +[W] Con m (Layer4 bind Ty) --> [W] bind ~ Expr t0 lrs0 [W] Con m (TStk t0 lrs0) diff --git a/testsuite/tests/typecheck/should_compile/T12734a.stderr b/testsuite/tests/typecheck/should_compile/T12734a.stderr index 737659fa57..8d777c6616 100644 --- a/testsuite/tests/typecheck/should_compile/T12734a.stderr +++ b/testsuite/tests/typecheck/should_compile/T12734a.stderr @@ -1,9 +1,8 @@ -T12734a.hs:71:16: error: - • No instance for (Monad (KT A '[Type] IO)) +T12734a.hs:72:16: error: + • No instance for (Monad (KT A '[Ty] IO)) arising from a use of ‘test_gr’ • In the expression: - test_gr @(KT A '[Type] IO) @_ @'[Type] @(Expr Net '[Type]) + test_gr @(KT A '[Ty] IO) @_ @'[Ty] @(Expr Net '[Ty]) In an equation for ‘test_ghc_err’: - test_ghc_err - = test_gr @(KT A '[Type] IO) @_ @'[Type] @(Expr Net '[Type]) + test_ghc_err = test_gr @(KT A '[Ty] IO) @_ @'[Ty] @(Expr Net '[Ty]) diff --git a/testsuite/tests/typecheck/should_compile/T12763.stderr b/testsuite/tests/typecheck/should_compile/T12763.stderr index 61db0a38c5..6ad696161f 100644 --- a/testsuite/tests/typecheck/should_compile/T12763.stderr +++ b/testsuite/tests/typecheck/should_compile/T12763.stderr @@ -10,5 +10,5 @@ COERCION AXIOMS INSTANCES instance C Int -- Defined at T12763.hs:9:10 Dependent modules: [] -Dependent packages: [base-4.10.0.0, ghc-prim-0.5.1.0, - integer-gmp-1.0.0.1] +Dependent packages: [base-4.12.0.0, ghc-prim-0.5.3, + integer-gmp-1.0.2.0] diff --git a/testsuite/tests/typecheck/should_compile/T12785a.hs b/testsuite/tests/typecheck/should_compile/T12785a.hs index 1e4d6a1b64..3c3fa9aba5 100644 --- a/testsuite/tests/typecheck/should_compile/T12785a.hs +++ b/testsuite/tests/typecheck/should_compile/T12785a.hs @@ -1,5 +1,5 @@ {-# LANGUAGE RankNTypes #-} -{-# LANGUAGE TypeInType #-} +{-# LANGUAGE PolyKinds #-} {-# LANGUAGE TypeFamilies #-} module T12785a where diff --git a/testsuite/tests/typecheck/should_compile/T12911.hs b/testsuite/tests/typecheck/should_compile/T12911.hs index 88c2125f2b..af3af3c5f3 100644 --- a/testsuite/tests/typecheck/should_compile/T12911.hs +++ b/testsuite/tests/typecheck/should_compile/T12911.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE ExplicitForAll, TypeInType, GADTSyntax, +{-# LANGUAGE ExplicitForAll, PolyKinds, GADTSyntax, ExistentialQuantification #-} module T12911 where diff --git a/testsuite/tests/typecheck/should_compile/T12919.hs b/testsuite/tests/typecheck/should_compile/T12919.hs index 1f77c1c8de..778abfa1e7 100644 --- a/testsuite/tests/typecheck/should_compile/T12919.hs +++ b/testsuite/tests/typecheck/should_compile/T12919.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE TypeInType, TypeFamilies, GADTs, ConstraintKinds #-} +{-# LANGUAGE DataKinds, PolyKinds, TypeFamilies, GADTs, ConstraintKinds #-} module T12919 where diff --git a/testsuite/tests/typecheck/should_compile/T12987.hs b/testsuite/tests/typecheck/should_compile/T12987.hs index 0997985601..3341272df9 100644 --- a/testsuite/tests/typecheck/should_compile/T12987.hs +++ b/testsuite/tests/typecheck/should_compile/T12987.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE TypeInType #-} +{-# LANGUAGE PolyKinds #-} module T12987 where diff --git a/testsuite/tests/typecheck/should_compile/T13032.hs b/testsuite/tests/typecheck/should_compile/T13032.hs new file mode 100644 index 0000000000..065656e20c --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/T13032.hs @@ -0,0 +1,12 @@ +{-# OPTIONS_GHC -ddump-ds -dsuppress-uniques #-} +{-# LANGUAGE GADTs #-} + +module T13032 where + +f :: (a ~ b) => a -> b -> Bool +f x y = True + +-- The point of the test is to check that we don't +-- get a redundant superclass selection to fetch an +-- equality constraint out of the (a~b) dictionary +-- Hence -ddump-ds diff --git a/testsuite/tests/typecheck/should_compile/T13032.stderr b/testsuite/tests/typecheck/should_compile/T13032.stderr new file mode 100644 index 0000000000..5492b791d7 --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/T13032.stderr @@ -0,0 +1,20 @@ + +==================== Desugar (after optimization) ==================== +Result size of Desugar (after optimization) + = {terms: 13, types: 24, coercions: 0, joins: 0/0} + +-- RHS size: {terms: 6, types: 11, coercions: 0, joins: 0/0} +f :: forall a b. (a ~ b) => a -> b -> Bool +[LclIdX] +f = \ (@ a) (@ b) _ [Occ=Dead] _ [Occ=Dead] _ [Occ=Dead] -> + GHC.Types.True + +-- RHS size: {terms: 5, types: 0, coercions: 0, joins: 0/0} +T13032.$trModule :: GHC.Types.Module +[LclIdX] +T13032.$trModule + = GHC.Types.Module + (GHC.Types.TrNameS "main"#) (GHC.Types.TrNameS "T13032"#) + + + diff --git a/testsuite/tests/typecheck/should_compile/T13050.stderr b/testsuite/tests/typecheck/should_compile/T13050.stderr index 723bdf02b6..36e22ae3f8 100644 --- a/testsuite/tests/typecheck/should_compile/T13050.stderr +++ b/testsuite/tests/typecheck/should_compile/T13050.stderr @@ -8,6 +8,82 @@ T13050.hs:4:9: warning: [-Wtyped-holes (in -Wdefault)] y :: Int (bound at T13050.hs:4:5) x :: Int (bound at T13050.hs:4:3) f :: Int -> Int -> Int (bound at T13050.hs:4:1) + Valid hole fits include + f :: Int -> Int -> Int (bound at T13050.hs:4:1) + g :: Int -> Int -> Int (bound at T13050.hs:5:1) + q :: Int -> Int -> Int (bound at T13050.hs:6:1) + seq :: forall a b. a -> b -> b + with seq @Int @Int + (imported from ‘Prelude’ at T13050.hs:1:8-17 + (and originally defined in ‘GHC.Prim’)) + (-) :: forall a. Num a => a -> a -> a + with (-) @Int + (imported from ‘Prelude’ at T13050.hs:1:8-17 + (and originally defined in ‘GHC.Num’)) + asTypeOf :: forall a. a -> a -> a + with asTypeOf @Int + (imported from ‘Prelude’ at T13050.hs:1:8-17 + (and originally defined in ‘GHC.Base’)) + const :: forall a b. a -> b -> a + with const @Int @Int + (imported from ‘Prelude’ at T13050.hs:1:8-17 + (and originally defined in ‘GHC.Base’)) + subtract :: forall a. Num a => a -> a -> a + with subtract @Int + (imported from ‘Prelude’ at T13050.hs:1:8-17 + (and originally defined in ‘GHC.Num’)) + (^) :: forall a b. (Num a, Integral b) => a -> b -> a + with (^) @Int @Int + (imported from ‘Prelude’ at T13050.hs:1:8-17 + (and originally defined in ‘GHC.Real’)) + gcd :: forall a. Integral a => a -> a -> a + with gcd @Int + (imported from ‘Prelude’ at T13050.hs:1:8-17 + (and originally defined in ‘GHC.Real’)) + lcm :: forall a. Integral a => a -> a -> a + with lcm @Int + (imported from ‘Prelude’ at T13050.hs:1:8-17 + (and originally defined in ‘GHC.Real’)) + (*) :: forall a. Num a => a -> a -> a + with (*) @Int + (imported from ‘Prelude’ at T13050.hs:1:8-17 + (and originally defined in ‘GHC.Num’)) + (+) :: forall a. Num a => a -> a -> a + with (+) @Int + (imported from ‘Prelude’ at T13050.hs:1:8-17 + (and originally defined in ‘GHC.Num’)) + div :: forall a. Integral a => a -> a -> a + with div @Int + (imported from ‘Prelude’ at T13050.hs:1:8-17 + (and originally defined in ‘GHC.Real’)) + mod :: forall a. Integral a => a -> a -> a + with mod @Int + (imported from ‘Prelude’ at T13050.hs:1:8-17 + (and originally defined in ‘GHC.Real’)) + quot :: forall a. Integral a => a -> a -> a + with quot @Int + (imported from ‘Prelude’ at T13050.hs:1:8-17 + (and originally defined in ‘GHC.Real’)) + rem :: forall a. Integral a => a -> a -> a + with rem @Int + (imported from ‘Prelude’ at T13050.hs:1:8-17 + (and originally defined in ‘GHC.Real’)) + max :: forall a. Ord a => a -> a -> a + with max @Int + (imported from ‘Prelude’ at T13050.hs:1:8-17 + (and originally defined in ‘GHC.Classes’)) + min :: forall a. Ord a => a -> a -> a + with min @Int + (imported from ‘Prelude’ at T13050.hs:1:8-17 + (and originally defined in ‘GHC.Classes’)) + return :: forall (m :: * -> *) a. Monad m => a -> m a + with return @((->) Int) @Int + (imported from ‘Prelude’ at T13050.hs:1:8-17 + (and originally defined in ‘GHC.Base’)) + pure :: forall (f :: * -> *) a. Applicative f => a -> f a + with pure @((->) Int) @Int + (imported from ‘Prelude’ at T13050.hs:1:8-17 + (and originally defined in ‘GHC.Base’)) T13050.hs:5:11: warning: [-Wtyped-holes (in -Wdefault)] • Found hole: _ :: Int -> Int -> Int @@ -18,8 +94,82 @@ T13050.hs:5:11: warning: [-Wtyped-holes (in -Wdefault)] y :: Int (bound at T13050.hs:5:5) x :: Int (bound at T13050.hs:5:3) g :: Int -> Int -> Int (bound at T13050.hs:5:1) - Valid substitutions include + Valid hole fits include + g :: Int -> Int -> Int (bound at T13050.hs:5:1) f :: Int -> Int -> Int (defined at T13050.hs:4:1) + q :: Int -> Int -> Int (bound at T13050.hs:6:1) + seq :: forall a b. a -> b -> b + with seq @Int @Int + (imported from ‘Prelude’ at T13050.hs:1:8-17 + (and originally defined in ‘GHC.Prim’)) + (-) :: forall a. Num a => a -> a -> a + with (-) @Int + (imported from ‘Prelude’ at T13050.hs:1:8-17 + (and originally defined in ‘GHC.Num’)) + asTypeOf :: forall a. a -> a -> a + with asTypeOf @Int + (imported from ‘Prelude’ at T13050.hs:1:8-17 + (and originally defined in ‘GHC.Base’)) + const :: forall a b. a -> b -> a + with const @Int @Int + (imported from ‘Prelude’ at T13050.hs:1:8-17 + (and originally defined in ‘GHC.Base’)) + subtract :: forall a. Num a => a -> a -> a + with subtract @Int + (imported from ‘Prelude’ at T13050.hs:1:8-17 + (and originally defined in ‘GHC.Num’)) + (^) :: forall a b. (Num a, Integral b) => a -> b -> a + with (^) @Int @Int + (imported from ‘Prelude’ at T13050.hs:1:8-17 + (and originally defined in ‘GHC.Real’)) + gcd :: forall a. Integral a => a -> a -> a + with gcd @Int + (imported from ‘Prelude’ at T13050.hs:1:8-17 + (and originally defined in ‘GHC.Real’)) + lcm :: forall a. Integral a => a -> a -> a + with lcm @Int + (imported from ‘Prelude’ at T13050.hs:1:8-17 + (and originally defined in ‘GHC.Real’)) + (*) :: forall a. Num a => a -> a -> a + with (*) @Int + (imported from ‘Prelude’ at T13050.hs:1:8-17 + (and originally defined in ‘GHC.Num’)) + (+) :: forall a. Num a => a -> a -> a + with (+) @Int + (imported from ‘Prelude’ at T13050.hs:1:8-17 + (and originally defined in ‘GHC.Num’)) + div :: forall a. Integral a => a -> a -> a + with div @Int + (imported from ‘Prelude’ at T13050.hs:1:8-17 + (and originally defined in ‘GHC.Real’)) + mod :: forall a. Integral a => a -> a -> a + with mod @Int + (imported from ‘Prelude’ at T13050.hs:1:8-17 + (and originally defined in ‘GHC.Real’)) + quot :: forall a. Integral a => a -> a -> a + with quot @Int + (imported from ‘Prelude’ at T13050.hs:1:8-17 + (and originally defined in ‘GHC.Real’)) + rem :: forall a. Integral a => a -> a -> a + with rem @Int + (imported from ‘Prelude’ at T13050.hs:1:8-17 + (and originally defined in ‘GHC.Real’)) + max :: forall a. Ord a => a -> a -> a + with max @Int + (imported from ‘Prelude’ at T13050.hs:1:8-17 + (and originally defined in ‘GHC.Classes’)) + min :: forall a. Ord a => a -> a -> a + with min @Int + (imported from ‘Prelude’ at T13050.hs:1:8-17 + (and originally defined in ‘GHC.Classes’)) + return :: forall (m :: * -> *) a. Monad m => a -> m a + with return @((->) Int) @Int + (imported from ‘Prelude’ at T13050.hs:1:8-17 + (and originally defined in ‘GHC.Base’)) + pure :: forall (f :: * -> *) a. Applicative f => a -> f a + with pure @((->) Int) @Int + (imported from ‘Prelude’ at T13050.hs:1:8-17 + (and originally defined in ‘GHC.Base’)) T13050.hs:6:11: warning: [-Wtyped-holes (in -Wdefault)] • Found hole: _a :: Int -> Int -> Int @@ -31,6 +181,79 @@ T13050.hs:6:11: warning: [-Wtyped-holes (in -Wdefault)] y :: Int (bound at T13050.hs:6:5) x :: Int (bound at T13050.hs:6:3) q :: Int -> Int -> Int (bound at T13050.hs:6:1) - Valid substitutions include + Valid hole fits include + q :: Int -> Int -> Int (bound at T13050.hs:6:1) f :: Int -> Int -> Int (defined at T13050.hs:4:1) g :: Int -> Int -> Int (defined at T13050.hs:5:1) + seq :: forall a b. a -> b -> b + with seq @Int @Int + (imported from ‘Prelude’ at T13050.hs:1:8-17 + (and originally defined in ‘GHC.Prim’)) + (-) :: forall a. Num a => a -> a -> a + with (-) @Int + (imported from ‘Prelude’ at T13050.hs:1:8-17 + (and originally defined in ‘GHC.Num’)) + asTypeOf :: forall a. a -> a -> a + with asTypeOf @Int + (imported from ‘Prelude’ at T13050.hs:1:8-17 + (and originally defined in ‘GHC.Base’)) + const :: forall a b. a -> b -> a + with const @Int @Int + (imported from ‘Prelude’ at T13050.hs:1:8-17 + (and originally defined in ‘GHC.Base’)) + subtract :: forall a. Num a => a -> a -> a + with subtract @Int + (imported from ‘Prelude’ at T13050.hs:1:8-17 + (and originally defined in ‘GHC.Num’)) + (^) :: forall a b. (Num a, Integral b) => a -> b -> a + with (^) @Int @Int + (imported from ‘Prelude’ at T13050.hs:1:8-17 + (and originally defined in ‘GHC.Real’)) + gcd :: forall a. Integral a => a -> a -> a + with gcd @Int + (imported from ‘Prelude’ at T13050.hs:1:8-17 + (and originally defined in ‘GHC.Real’)) + lcm :: forall a. Integral a => a -> a -> a + with lcm @Int + (imported from ‘Prelude’ at T13050.hs:1:8-17 + (and originally defined in ‘GHC.Real’)) + (*) :: forall a. Num a => a -> a -> a + with (*) @Int + (imported from ‘Prelude’ at T13050.hs:1:8-17 + (and originally defined in ‘GHC.Num’)) + (+) :: forall a. Num a => a -> a -> a + with (+) @Int + (imported from ‘Prelude’ at T13050.hs:1:8-17 + (and originally defined in ‘GHC.Num’)) + div :: forall a. Integral a => a -> a -> a + with div @Int + (imported from ‘Prelude’ at T13050.hs:1:8-17 + (and originally defined in ‘GHC.Real’)) + mod :: forall a. Integral a => a -> a -> a + with mod @Int + (imported from ‘Prelude’ at T13050.hs:1:8-17 + (and originally defined in ‘GHC.Real’)) + quot :: forall a. Integral a => a -> a -> a + with quot @Int + (imported from ‘Prelude’ at T13050.hs:1:8-17 + (and originally defined in ‘GHC.Real’)) + rem :: forall a. Integral a => a -> a -> a + with rem @Int + (imported from ‘Prelude’ at T13050.hs:1:8-17 + (and originally defined in ‘GHC.Real’)) + max :: forall a. Ord a => a -> a -> a + with max @Int + (imported from ‘Prelude’ at T13050.hs:1:8-17 + (and originally defined in ‘GHC.Classes’)) + min :: forall a. Ord a => a -> a -> a + with min @Int + (imported from ‘Prelude’ at T13050.hs:1:8-17 + (and originally defined in ‘GHC.Classes’)) + return :: forall (m :: * -> *) a. Monad m => a -> m a + with return @((->) Int) @Int + (imported from ‘Prelude’ at T13050.hs:1:8-17 + (and originally defined in ‘GHC.Base’)) + pure :: forall (f :: * -> *) a. Applicative f => a -> f a + with pure @((->) Int) @Int + (imported from ‘Prelude’ at T13050.hs:1:8-17 + (and originally defined in ‘GHC.Base’)) diff --git a/testsuite/tests/typecheck/should_compile/T13083.hs b/testsuite/tests/typecheck/should_compile/T13083.hs index 220da0855a..e294052309 100644 --- a/testsuite/tests/typecheck/should_compile/T13083.hs +++ b/testsuite/tests/typecheck/should_compile/T13083.hs @@ -8,11 +8,12 @@ module T13083 where +import Data.Kind import GHC.Generics (Par1(..),(:*:)(..)) import GHC.Exts (coerce) -- Representation as free vector space -type family V (a :: *) :: * -> * +type family V (a :: Type) :: Type -> Type type instance V R = Par1 type instance V (a,b) = V a :*: V b @@ -59,7 +60,7 @@ foo = coerce -- with that of ‘Par1’ -- arising from a use of ‘coerce’ --- Note that Par1 has the wrong kind (* -> *) for V Par1 +-- Note that Par1 has the wrong kind (Type -> Type) for V Par1 -- Same error: -- diff --git a/testsuite/tests/typecheck/should_compile/T13333.hs b/testsuite/tests/typecheck/should_compile/T13333.hs index fba64cede0..5aca099c3b 100644 --- a/testsuite/tests/typecheck/should_compile/T13333.hs +++ b/testsuite/tests/typecheck/should_compile/T13333.hs @@ -4,7 +4,7 @@ {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeInType #-} +{-# LANGUAGE PolyKinds #-} {-# LANGUAGE TypeOperators #-} module T13333 where diff --git a/testsuite/tests/typecheck/should_compile/T13337.hs b/testsuite/tests/typecheck/should_compile/T13337.hs index 39808b4f13..3448d9448a 100644 --- a/testsuite/tests/typecheck/should_compile/T13337.hs +++ b/testsuite/tests/typecheck/should_compile/T13337.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE TypeInType, ScopedTypeVariables, TypeOperators, GADTs #-} +{-# LANGUAGE PolyKinds, ScopedTypeVariables, TypeOperators, GADTs #-} {-# OPTIONS_GHC -Wno-overlapping-patterns #-} -- don't want erroneous warning in test output -- if removing this doesn't change output, then -- remove it! diff --git a/testsuite/tests/typecheck/should_compile/T13343.hs b/testsuite/tests/typecheck/should_compile/T13343.hs index ab259e3c45..fcff9db1a4 100644 --- a/testsuite/tests/typecheck/should_compile/T13343.hs +++ b/testsuite/tests/typecheck/should_compile/T13343.hs @@ -1,7 +1,9 @@ {-# LANGUAGE RankNTypes #-} -{-# LANGUAGE TypeInType #-} +{-# LANGUAGE PolyKinds #-} module Bug where import GHC.Exts type Bad = forall (v1 :: RuntimeRep) (a1 :: TYPE v). a1 + +-- should be accepted because GHC will generalize over v. Note v /= v1. diff --git a/testsuite/tests/typecheck/should_compile/T13458.hs b/testsuite/tests/typecheck/should_compile/T13458.hs index 9b51378d65..ef1f568769 100644 --- a/testsuite/tests/typecheck/should_compile/T13458.hs +++ b/testsuite/tests/typecheck/should_compile/T13458.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE MagicHash, TypeInType, ScopedTypeVariables #-} +{-# LANGUAGE MagicHash, PolyKinds, ScopedTypeVariables #-} {-# OPTIONS_GHC -O #-} module T13458 where import GHC.Exts diff --git a/testsuite/tests/typecheck/should_compile/T13526.stderr b/testsuite/tests/typecheck/should_compile/T13526.stderr index 7a0f2ae7c6..ad5876ec9e 100644 --- a/testsuite/tests/typecheck/should_compile/T13526.stderr +++ b/testsuite/tests/typecheck/should_compile/T13526.stderr @@ -1,7 +1,7 @@ T13526.hs:21:8: warning: [-Wsimplifiable-class-constraints (in -Wdefault)] - • The constraint ‘C (Maybe a)’ matches an instance declaration - instance C a => C (Maybe a) -- Defined at T13526.hs:14:10 + • The constraint ‘C (Maybe a)’ matches + instance C a => C (Maybe a) -- Defined at T13526.hs:14:10 This makes type inference for inner bindings fragile; either use MonoLocalBinds, or simplify it using the instance • In the type signature: bar :: C (Maybe a) => a -> Maybe a diff --git a/testsuite/tests/typecheck/should_compile/T13594.stderr b/testsuite/tests/typecheck/should_compile/T13594.stderr new file mode 100644 index 0000000000..57810cc1e6 --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/T13594.stderr @@ -0,0 +1,3 @@ + +T13594.hs:8:1: error: + Top-level strict bindings aren't allowed: !x = (1, 2) diff --git a/testsuite/tests/typecheck/should_compile/T13603.hs b/testsuite/tests/typecheck/should_compile/T13603.hs index d0c1975e04..bcbed465b0 100644 --- a/testsuite/tests/typecheck/should_compile/T13603.hs +++ b/testsuite/tests/typecheck/should_compile/T13603.hs @@ -1,4 +1,4 @@ -{-# Language PolyKinds, TypeInType, UndecidableInstances #-} +{-# Language PolyKinds, UndecidableInstances #-} module T13603 where import GHC.Exts (TYPE, RuntimeRep) diff --git a/testsuite/tests/typecheck/should_compile/T13643.hs b/testsuite/tests/typecheck/should_compile/T13643.hs new file mode 100644 index 0000000000..68e7225bf8 --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/T13643.hs @@ -0,0 +1,22 @@ +{-# Language TypeFamilyDependencies #-} +{-# Language RankNTypes #-} +{-# Language KindSignatures #-} +{-# Language DataKinds #-} +{-# Language PolyKinds #-} +{-# Language GADTs #-} + +import Data.Kind (Type) + +data Code = I + +type family + Interp (a :: Code) = (res :: Type) | res -> a where + Interp I = Bool + +data T :: forall a. Interp a -> Type where + MkNat :: T False + +instance Show (T a) where show _ = "MkNat" + +main = do + print MkNat diff --git a/testsuite/tests/typecheck/should_compile/T13651.hs b/testsuite/tests/typecheck/should_compile/T13651.hs index 43ae633534..63bd88eb5c 100644 --- a/testsuite/tests/typecheck/should_compile/T13651.hs +++ b/testsuite/tests/typecheck/should_compile/T13651.hs @@ -12,3 +12,24 @@ foo :: (F cr cu ~ Bar h (Bar r u), F cu cs ~ Bar (Foo h) (Bar u s)) => Bar h (Bar r u) -> Bar (Foo h) (Bar u s) -> Foo (cr -> cs) foo = undefined + +{- Typechecking this program used to /just/ succeed in GHC 8.2, + (see Trac #14745 for why), but doesn't in 8.4. + +[G] F cr cu ~ Bar h (Bar r u), + F cu cs ~ Bar (Foo h) (Bar u s)) + + +[W] F cr cu0 ~ Bar h (Bar r u) + --> (top-level fundeps) cr ~ Bar h (Foo r) + cu0 ~ Bar h (Foo u) + (local fundeps) cu ~ cu0 + +[W] F cu0 cs ~ Bar (Foo h) (Bar u s) + --> (top-level fundeps) cu0 ~ Bar (Foo h) (Foo u) + cs ~ Bar (Foo h) (Foo s) + (local fundeps) cu0 ~ cu + +[W] F cr (Bar (Foo h) (Fo u)) ~ Bar h (Bar r u) + +-} diff --git a/testsuite/tests/typecheck/should_compile/T13651.stderr b/testsuite/tests/typecheck/should_compile/T13651.stderr new file mode 100644 index 0000000000..6b6c64302f --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/T13651.stderr @@ -0,0 +1,16 @@ + +T13651.hs:11:8: error: + • Could not deduce: F cr (Bar (Foo h) (Foo u)) ~ Bar h (Bar r u) + from the context: (F cr cu ~ Bar h (Bar r u), + F cu cs ~ Bar (Foo h) (Bar u s)) + bound by the type signature for: + foo :: forall cr cu h r u cs s. + (F cr cu ~ Bar h (Bar r u), F cu cs ~ Bar (Foo h) (Bar u s)) => + Bar h (Bar r u) -> Bar (Foo h) (Bar u s) -> Foo (cr -> cs) + at T13651.hs:(11,8)-(13,65) + • In the ambiguity check for ‘foo’ + To defer the ambiguity check to use sites, enable AllowAmbiguousTypes + In the type signature: + foo :: (F cr cu ~ Bar h (Bar r u), + F cu cs ~ Bar (Foo h) (Bar u s)) => + Bar h (Bar r u) -> Bar (Foo h) (Bar u s) -> Foo (cr -> cs) diff --git a/testsuite/tests/typecheck/should_compile/T13651a.hs b/testsuite/tests/typecheck/should_compile/T13651a.hs new file mode 100644 index 0000000000..482231b6f2 --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/T13651a.hs @@ -0,0 +1,16 @@ +{-# LANGUAGE TypeFamilies, TypeFamilyDependencies #-} +module T13651 where + +type family F r s = f | f -> r s + +type instance F (Bar h (Foo r)) (Bar h (Foo s)) = Bar h (Bar r s) + +data Bar s b +data Foo a + +foo :: (F cr cu ~ Bar h (Bar r u), + F cu cs ~ Bar (Foo h) (Bar u s)) + => Bar h (Bar r u) -> Bar (Foo h) (Bar u s) -> cu -> Foo (cr -> cs) + -- A variant of T13651 which fixes 'cu' + -- as well as the other type args +foo = undefined diff --git a/testsuite/tests/typecheck/should_compile/T13822.hs b/testsuite/tests/typecheck/should_compile/T13822.hs index 5837cc8081..88c14c2aff 100644 --- a/testsuite/tests/typecheck/should_compile/T13822.hs +++ b/testsuite/tests/typecheck/should_compile/T13822.hs @@ -1,4 +1,5 @@ -{-# LANGUAGE GADTs, TypeOperators, PolyKinds, DataKinds, TypeFamilyDependencies, TypeInType, RankNTypes, LambdaCase, EmptyCase #-} +{-# LANGUAGE GADTs, TypeOperators, PolyKinds, DataKinds, + TypeFamilyDependencies, RankNTypes, LambdaCase, EmptyCase #-} module T13822 where diff --git a/testsuite/tests/typecheck/should_compile/T13833.hs b/testsuite/tests/typecheck/should_compile/T13833.hs new file mode 100644 index 0000000000..266b00bd60 --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/T13833.hs @@ -0,0 +1,12 @@ +{-# LANGUAGE DataKinds, KindSignatures #-} + +import GHC.TypeLits (Nat, Symbol) + +class A (n::Nat) +instance A 0 + +class B (s::Symbol) +instance B "B" + +main :: IO () +main = return () diff --git a/testsuite/tests/typecheck/should_compile/T13848.hs b/testsuite/tests/typecheck/should_compile/T13848.hs new file mode 100644 index 0000000000..36c45b49fc --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/T13848.hs @@ -0,0 +1,41 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE ExistentialQuantification #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} +module T13848 where + +data N = Z | S N + +data Vec1 (n :: N) a where + VNil1 :: forall a. Vec1 Z a + VCons1 :: forall n a. a -> Vec1 n a -> Vec1 (S n) a + +data Vec2 (n :: N) a where + VNil2 :: Vec2 Z a + VCons2 :: a -> Vec2 n a -> Vec2 (S n) a + +data Vec3 (n :: N) a + = (n ~ Z) => VNil3 + | forall (n' :: N). (n ~ S n') => VCons3 a (Vec3 n' a) + +vcons1 :: Vec1 (S Z) Int +vcons1 = VCons1 @Z @Int 1 (VNil1 @Int) + +vcons2 :: Vec2 (S Z) Int +vcons2 = VCons2 @Int @Z 1 (VNil2 @Int) + +vcons3 :: Vec3 (S Z) Int +vcons3 = VCons3 @(S Z) @Int @Z 1 (VNil3 @Z @Int) + +newtype Result1 a s = Ok1 s + +newtype Result2 a s where + Ok2 :: s -> Result2 a s + +result1 :: Result1 Int Char +result1 = Ok1 @Int @Char 'a' + +result2 :: Result2 Int Char +result2 = Ok2 @Char @Int 'a' diff --git a/testsuite/tests/typecheck/should_compile/T13871.hs b/testsuite/tests/typecheck/should_compile/T13871.hs index 319d949647..623923eaca 100644 --- a/testsuite/tests/typecheck/should_compile/T13871.hs +++ b/testsuite/tests/typecheck/should_compile/T13871.hs @@ -1,7 +1,7 @@ {-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE TypeInType #-} +{-# LANGUAGE DataKinds, PolyKinds #-} {-# LANGUAGE TypeOperators #-} module Foo where diff --git a/testsuite/tests/typecheck/should_compile/T13879.hs b/testsuite/tests/typecheck/should_compile/T13879.hs index 9708c1dd41..2e10c472fb 100644 --- a/testsuite/tests/typecheck/should_compile/T13879.hs +++ b/testsuite/tests/typecheck/should_compile/T13879.hs @@ -2,7 +2,7 @@ {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE TypeInType #-} +{-# LANGUAGE DataKinds, PolyKinds #-} {-# LANGUAGE TypeOperators #-} module Bug where diff --git a/testsuite/tests/typecheck/should_compile/T13915a.hs b/testsuite/tests/typecheck/should_compile/T13915a.hs index 484c9dedc0..355166b8a0 100644 --- a/testsuite/tests/typecheck/should_compile/T13915a.hs +++ b/testsuite/tests/typecheck/should_compile/T13915a.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE TypeInType #-} +{-# LANGUAGE DataKinds, PolyKinds #-} module Bug where import T13915a_Foo diff --git a/testsuite/tests/typecheck/should_compile/T13915b.hs b/testsuite/tests/typecheck/should_compile/T13915b.hs index dd64b13d4f..8949a86f06 100644 --- a/testsuite/tests/typecheck/should_compile/T13915b.hs +++ b/testsuite/tests/typecheck/should_compile/T13915b.hs @@ -1,5 +1,5 @@ {-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE TypeInType #-} +{-# LANGUAGE DataKinds #-} module Foo where import Data.Typeable (Proxy(..), typeRep) diff --git a/testsuite/tests/typecheck/should_compile/T13943.hs b/testsuite/tests/typecheck/should_compile/T13943.hs new file mode 100644 index 0000000000..7889fe6a41 --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/T13943.hs @@ -0,0 +1,68 @@ +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE PolyKinds, DataKinds #-} +{-# LANGUAGE AllowAmbiguousTypes #-} +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE GADTs #-} + +module Data.List.Unrolled where + +import GHC.TypeLits + +-- | Drop @n@ elements from a list +class Drop (n :: Nat) where + drop :: [a] -> [a] + +instance {-# OVERLAPPING #-} Drop 0 where + drop xs = xs + {-# INLINE drop #-} + +instance {-# OVERLAPPABLE #-} (Drop (n - 1)) => Drop n where + drop [] = [] + drop (_ : xs) = drop @(n - 1) xs + {-# INLINE drop #-} + +-- | Take @n@ elements from a list +class Take (n :: Nat) where + take :: [a] -> [a] + +instance {-# OVERLAPPING #-} Take 0 where + take _ = [] + {-# INLINE take #-} + +instance {-# OVERLAPPABLE #-} (Take (n - 1)) => Take n where + take [] = [] + take (x : xs) = x : take @(n - 1) xs + {-# INLINE take #-} + +-- | Split list at @n@-th element. +splitAt :: forall (n :: Nat) a. (Take n, Drop n) => [a] -> ([a], [a]) +splitAt xs = (take @n xs, drop @n xs) + +-- | Split list into chunks of the given length @c@. @n@ is length of the list. +class ChunksOf (n :: Nat) (c :: Nat) where + chunksOf :: [a] -> [[a]] + +instance {-# OVERLAPPING #-} ChunksOf 0 0 where + chunksOf _ = [] + {-# INLINE chunksOf #-} + +instance {-# OVERLAPPABLE #-} ChunksOf 0 c where + chunksOf _ = [] + {-# INLINE chunksOf #-} + +instance {-# OVERLAPPABLE #-} ChunksOf n 0 where + chunksOf _ = [] + {-# INLINE chunksOf #-} + + +instance {-# OVERLAPPABLE #-} (Take c, Drop c, ChunksOf (n - 1) c) => ChunksOf n c where + chunksOf xs = + let (l, r) = splitAt @c xs + in l : chunksOf @(n - 1) @c r + {-# INLINE chunksOf #-} diff --git a/testsuite/tests/typecheck/should_compile/T14128.hs b/testsuite/tests/typecheck/should_compile/T14128.hs new file mode 100644 index 0000000000..a1159c6da7 --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/T14128.hs @@ -0,0 +1,7 @@ +module T14128 where + +import T14128Type +import {-# SOURCE #-} T14128a + +instance Show AType where + show AType = "hello" diff --git a/testsuite/tests/typecheck/should_compile/T14128.hs-boot b/testsuite/tests/typecheck/should_compile/T14128.hs-boot new file mode 100644 index 0000000000..27ef36afdb --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/T14128.hs-boot @@ -0,0 +1,5 @@ +module T14128 where + +import T14128Type + +instance Show AType diff --git a/testsuite/tests/typecheck/should_compile/T14128Main.hs b/testsuite/tests/typecheck/should_compile/T14128Main.hs new file mode 100644 index 0000000000..9407606c1d --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/T14128Main.hs @@ -0,0 +1,10 @@ +module T14128Main where + +import T14128 + +-- Overview: +-- * T14128Main is imports T14128 +-- * T14128Type defines datatype MyType +-- * T14128 has a boot file and defines a orphan Show instance; it SOURCE +-- imports T14128 +-- * T14128a has a boot file which SOURCE imports T14128 diff --git a/testsuite/tests/typecheck/should_compile/T14128Type.hs b/testsuite/tests/typecheck/should_compile/T14128Type.hs new file mode 100644 index 0000000000..f64ec4853f --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/T14128Type.hs @@ -0,0 +1,3 @@ +module T14128Type where + +data AType = AType diff --git a/testsuite/tests/typecheck/should_compile/T14128a.hs b/testsuite/tests/typecheck/should_compile/T14128a.hs new file mode 100644 index 0000000000..a93b2fe4b8 --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/T14128a.hs @@ -0,0 +1 @@ +module T14128a where diff --git a/testsuite/tests/typecheck/should_compile/T14128a.hs-boot b/testsuite/tests/typecheck/should_compile/T14128a.hs-boot new file mode 100644 index 0000000000..e38681a22c --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/T14128a.hs-boot @@ -0,0 +1,3 @@ +module T14128a where + +import {-# SOURCE #-} T14128 diff --git a/testsuite/tests/typecheck/should_compile/T14149.hs b/testsuite/tests/typecheck/should_compile/T14149.hs new file mode 100644 index 0000000000..c23d415342 --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/T14149.hs @@ -0,0 +1,8 @@ +{-# OPTIONS_GHC -fdefer-out-of-scope-variables #-} + +module Foo where + +import Data.Coerce + +f :: Bool +f = coerce (k :: Int) diff --git a/testsuite/tests/typecheck/should_compile/T14149.stderr b/testsuite/tests/typecheck/should_compile/T14149.stderr new file mode 100644 index 0000000000..b1a8d3720c --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/T14149.stderr @@ -0,0 +1,6 @@ + +T14149.hs:8:5: error: + • Couldn't match representation of type ‘Int’ with that of ‘Bool’ + arising from a use of ‘coerce’ + • In the expression: coerce (k :: Int) + In an equation for ‘f’: f = coerce (k :: Int) diff --git a/testsuite/tests/typecheck/should_compile/T14154.hs b/testsuite/tests/typecheck/should_compile/T14154.hs new file mode 100644 index 0000000000..e29ee85504 --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/T14154.hs @@ -0,0 +1,16 @@ +{-# Language RankNTypes, DerivingStrategies, TypeApplications, + ScopedTypeVariables, GADTs, PolyKinds #-} + +module T14154 where + +newtype Ran g h a + = MkRan (forall b. (a -> g b) -> h b) + +newtype Swap p f g a where + MkSwap :: p g f a -> Swap p f g a + +ireturn :: forall m i a. a -> m i i a +ireturn = undefined + +xs = case ireturn @(Swap Ran) 'a' of + MkSwap (MkRan f) -> f print diff --git a/testsuite/tests/typecheck/should_compile/T14158.hs b/testsuite/tests/typecheck/should_compile/T14158.hs new file mode 100644 index 0000000000..88bb82ed98 --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/T14158.hs @@ -0,0 +1,7 @@ +{-# LANGUAGE TypeApplications #-} + +module T14158 where + +import qualified Control.Category as Cat + +foo = (Cat.id @(->) >>=) diff --git a/testsuite/tests/typecheck/should_compile/T14185.hs b/testsuite/tests/typecheck/should_compile/T14185.hs new file mode 100644 index 0000000000..41e47d2913 --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/T14185.hs @@ -0,0 +1,30 @@ +{-# LANGUAGE MagicHash, UnboxedTuples, MultiParamTypeClasses, TypeFamilies, + FunctionalDependencies, KindSignatures, PolyKinds, DataKinds, + UndecidableInstances #-} +module T14185 where + +import GHC.Types +import GHC.Prim + + +class Unbox (t :: *) (r :: TYPE k) | t -> r, r -> t where + unbox :: t -> r + box :: r -> t + +instance Unbox Int Int# where + unbox (I# i) = i + box i = I# i + +instance Unbox Char Char# where + unbox (C# c) = c + box c = C# c + +instance (Unbox a a', Unbox b b') => Unbox (a,b) (# a', b' #) where + unbox (a,b) = (# unbox a, unbox b #) + box (# a, b #) = (box a, box b) + +testInt :: Int +testInt = box (unbox 1) + +testTup :: (Int, Char) +testTup = box (unbox (1, 'a')) diff --git a/testsuite/tests/typecheck/should_compile/T14273.hs b/testsuite/tests/typecheck/should_compile/T14273.hs new file mode 100644 index 0000000000..b813237120 --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/T14273.hs @@ -0,0 +1,13 @@ +module TypeClassConstraintsInformedHoles where + +-- Make sure that constraints imposed by the call site +-- are handled. See trac #14273 +pleaseShow :: Show a => Bool -> a -> Maybe String +pleaseShow False _ = Nothing +pleaseShow True a = Just (show _a) + +k :: String +k = "I fit into the hole in foo!" + +foo :: [a] -> String +foo xs = show (_h ++ []) diff --git a/testsuite/tests/typecheck/should_compile/T14273.stderr b/testsuite/tests/typecheck/should_compile/T14273.stderr new file mode 100644 index 0000000000..cb4be120f7 --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/T14273.stderr @@ -0,0 +1,83 @@ + +T14273.hs:7:27: warning: [-Wdeferred-type-errors (in -Wdefault)] + • Could not deduce (Show a1) arising from a use of ‘show’ + from the context: Show a + bound by the type signature for: + pleaseShow :: forall a. Show a => Bool -> a -> Maybe String + at T14273.hs:5:1-49 + The type variable ‘a1’ is ambiguous + These potential instances exist: + instance (Show a, Show b) => Show (Either a b) + -- Defined in ‘Data.Either’ + instance Show Ordering -- Defined in ‘GHC.Show’ + instance Show Integer -- Defined in ‘GHC.Show’ + ...plus 23 others + ...plus 70 instances involving out-of-scope types + (use -fprint-potential-instances to see them all) + • In the first argument of ‘Just’, namely ‘(show _a)’ + In the expression: Just (show _a) + In an equation for ‘pleaseShow’: pleaseShow True a = Just (show _a) + +T14273.hs:7:32: warning: [-Wtyped-holes (in -Wdefault)] + • Found hole: _a :: a1 + Where: ‘a1’ is an ambiguous type variable + Or perhaps ‘_a’ is mis-spelled, or not in scope + • In the first argument of ‘show’, namely ‘_a’ + In the first argument of ‘Just’, namely ‘(show _a)’ + In the expression: Just (show _a) + • Relevant bindings include + a :: a (bound at T14273.hs:7:17) + pleaseShow :: Bool -> a -> Maybe String (bound at T14273.hs:6:1) + Constraints include Show a (from T14273.hs:5:1-49) + Valid hole fits include + a :: a (bound at T14273.hs:7:17) + k :: String (bound at T14273.hs:10:1) + otherwise :: Bool + (imported from ‘Prelude’ at T14273.hs:1:8-40 + (and originally defined in ‘GHC.Base’)) + False :: Bool + (imported from ‘Prelude’ at T14273.hs:1:8-40 + (and originally defined in ‘GHC.Types’)) + True :: Bool + (imported from ‘Prelude’ at T14273.hs:1:8-40 + (and originally defined in ‘GHC.Types’)) + EQ :: Ordering + (imported from ‘Prelude’ at T14273.hs:1:8-40 + (and originally defined in ‘GHC.Types’)) + LT :: Ordering + (imported from ‘Prelude’ at T14273.hs:1:8-40 + (and originally defined in ‘GHC.Types’)) + GT :: Ordering + (imported from ‘Prelude’ at T14273.hs:1:8-40 + (and originally defined in ‘GHC.Types’)) + pi :: forall a. Floating a => a + with pi @Double + (imported from ‘Prelude’ at T14273.hs:1:8-40 + (and originally defined in ‘GHC.Float’)) + +T14273.hs:13:10: warning: [-Wdeferred-type-errors (in -Wdefault)] + • Ambiguous type variable ‘a0’ arising from a use of ‘show’ + prevents the constraint ‘(Show a0)’ from being solved. + Probable fix: use a type annotation to specify what ‘a0’ should be. + These potential instances exist: + instance (Show a, Show b) => Show (Either a b) + -- Defined in ‘Data.Either’ + instance Show Ordering -- Defined in ‘GHC.Show’ + instance Show Integer -- Defined in ‘GHC.Show’ + ...plus 23 others + ...plus 70 instances involving out-of-scope types + (use -fprint-potential-instances to see them all) + • In the expression: show (_h ++ []) + In an equation for ‘foo’: foo xs = show (_h ++ []) + +T14273.hs:13:16: warning: [-Wtyped-holes (in -Wdefault)] + • Found hole: _h :: [a0] + Where: ‘a0’ is an ambiguous type variable + Or perhaps ‘_h’ is mis-spelled, or not in scope + • In the first argument of ‘(++)’, namely ‘_h’ + In the first argument of ‘show’, namely ‘(_h ++ [])’ + In the expression: show (_h ++ []) + • Relevant bindings include + xs :: [a] (bound at T14273.hs:13:5) + foo :: [a] -> String (bound at T14273.hs:13:1) + Valid hole fits include k :: String (defined at T14273.hs:10:1) diff --git a/testsuite/tests/typecheck/should_compile/T14333.hs b/testsuite/tests/typecheck/should_compile/T14333.hs new file mode 100644 index 0000000000..f4cd3bdf2b --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/T14333.hs @@ -0,0 +1,20 @@ +module T14333 where + +import Data.Coerce + +bad :: Coercible (a b) (c d) => c d -> a b +bad = coerce + +bad2 :: Coercible (c d) (a b) => c d -> a b +bad2 = coerce + +bad3 :: Coercible (a b) b => b -> a b +bad3 = coerce + +bad4 :: Coercible b (a b) => b -> a b +bad4 = coerce + +newtype Id a = MkId a + +foo :: Id Int +foo = bad3 (3 :: Int) diff --git a/testsuite/tests/typecheck/should_compile/T14363.hs b/testsuite/tests/typecheck/should_compile/T14363.hs new file mode 100644 index 0000000000..fe8966e5a2 --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/T14363.hs @@ -0,0 +1,11 @@ +module T14363 where + +import Data.Coerce + +foo x = [fmap, coerce] +-- Should work +-- foo :: forall b (f :: * -> *) a p. +-- (Functor f, Coercible a (f a), Coercible b (f b)) => +-- p -> [(a -> b) -> f a -> f b] +-- +-- Failed in 8.2 diff --git a/testsuite/tests/typecheck/should_compile/T14363a.hs b/testsuite/tests/typecheck/should_compile/T14363a.hs new file mode 100644 index 0000000000..4a38ab53f3 --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/T14363a.hs @@ -0,0 +1,8 @@ +module T14363a where + +import Data.Coerce + +contra :: (a -> b) -> (f b -> f a) +contra = undefined + +foo x = [coerce, contra] diff --git a/testsuite/tests/typecheck/should_compile/T14396.hs b/testsuite/tests/typecheck/should_compile/T14396.hs new file mode 100644 index 0000000000..2d6c7061c3 --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/T14396.hs @@ -0,0 +1,4 @@ +module T14396 where +import T14396a +import T14396b +data S = S diff --git a/testsuite/tests/typecheck/should_compile/T14396.hs-boot b/testsuite/tests/typecheck/should_compile/T14396.hs-boot new file mode 100644 index 0000000000..d4fe8673c3 --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/T14396.hs-boot @@ -0,0 +1,2 @@ +module T14396 where +data S = S diff --git a/testsuite/tests/typecheck/should_compile/T14396a.hs b/testsuite/tests/typecheck/should_compile/T14396a.hs new file mode 100644 index 0000000000..28a276c719 --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/T14396a.hs @@ -0,0 +1,5 @@ +{-# LANGUAGE TypeFamilies #-} +module T14396a where +import T14396f +import {-# SOURCE #-} T14396(S) +type instance F Int = S diff --git a/testsuite/tests/typecheck/should_compile/T14396b.hs b/testsuite/tests/typecheck/should_compile/T14396b.hs new file mode 100644 index 0000000000..aabf3f3dcc --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/T14396b.hs @@ -0,0 +1,4 @@ +{-# LANGUAGE TypeFamilies #-} +module T14396b where +import T14396f +type instance F Bool = Int diff --git a/testsuite/tests/typecheck/should_compile/T14396f.hs b/testsuite/tests/typecheck/should_compile/T14396f.hs new file mode 100644 index 0000000000..e6230fd11b --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/T14396f.hs @@ -0,0 +1,3 @@ +{-# LANGUAGE TypeFamilies #-} +module T14396f where +type family F a diff --git a/testsuite/tests/typecheck/should_compile/T14434.hs b/testsuite/tests/typecheck/should_compile/T14434.hs new file mode 100644 index 0000000000..a0d0442fed --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/T14434.hs @@ -0,0 +1,17 @@ +{-# LANGUAGE MonoLocalBinds, FlexibleInstances, OverloadedStrings #-} +{-# OPTIONS -fsolve-constant-dicts #-} + +module T14434 where + +class ToString a where + toString :: a -> String + +-- | This instance is used in original code as hack +-- to simplify code generation +instance {-# OVERLAPPABLE #-} ToString a where + toString _ = "Catchall attribute value" + +toStringX :: (ToString a) => a -> String +toStringX = toString + -- Here we do /not/ want to solve the ToString + -- constraint with the local instance diff --git a/testsuite/tests/typecheck/should_compile/T14434.stdout b/testsuite/tests/typecheck/should_compile/T14434.stdout new file mode 100644 index 0000000000..f1436e3959 --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/T14434.stdout @@ -0,0 +1,2 @@ +toStringX :: forall a. ToString a => a -> String +toStringX = toString diff --git a/testsuite/tests/typecheck/should_compile/T14441.hs b/testsuite/tests/typecheck/should_compile/T14441.hs new file mode 100644 index 0000000000..a2c1aff9ef --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/T14441.hs @@ -0,0 +1,16 @@ +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE PolyKinds #-} +module T14441 where + +import Data.Kind + +type family Demote (k :: Type) :: Type +type family DemoteX (a :: k) :: Demote k + +data Prox (a :: k) = P + +type instance Demote (Prox (a :: k)) = Prox (DemoteX a) +$(return []) +type instance DemoteX P = P diff --git a/testsuite/tests/typecheck/should_compile/T14488.hs b/testsuite/tests/typecheck/should_compile/T14488.hs new file mode 100644 index 0000000000..a4a12841b7 --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/T14488.hs @@ -0,0 +1,10 @@ +{-# LANGUAGE RankNTypes #-} + +module T14488 where + +type Lens' s a = forall f. Functor f => (a -> f a) -> s -> f s + +data T a = MkT { _tfield :: Eq a => a } + +tfield :: Eq a => Lens' (T a) a +tfield f t = MkT <$> f (_tfield t) diff --git a/testsuite/tests/typecheck/should_compile/T14590.hs b/testsuite/tests/typecheck/should_compile/T14590.hs new file mode 100644 index 0000000000..f687d52dea --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/T14590.hs @@ -0,0 +1,7 @@ +module T14590 where + +f1, f2, f3, f4 :: Int -> Int -> Int +f1 x y = (x `_`) y +f2 x y = (x `_a`) y +f3 x y = (`_` x) y +f4 x y = (`_a` x) y diff --git a/testsuite/tests/typecheck/should_compile/T14590.stderr b/testsuite/tests/typecheck/should_compile/T14590.stderr new file mode 100644 index 0000000000..455898be1a --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/T14590.stderr @@ -0,0 +1,350 @@ + +T14590.hs:4:13: warning: [-Wtyped-holes (in -Wdefault)] + • Found hole: _ :: Int -> Int -> Int + • In the expression: _ + In the expression: x `_` + In the expression: (x `_`) y + • Relevant bindings include + y :: Int (bound at T14590.hs:4:6) + x :: Int (bound at T14590.hs:4:4) + f1 :: Int -> Int -> Int (bound at T14590.hs:4:1) + Valid hole fits include + f1 :: Int -> Int -> Int (bound at T14590.hs:4:1) + f2 :: Int -> Int -> Int (bound at T14590.hs:5:1) + f3 :: Int -> Int -> Int (bound at T14590.hs:6:1) + f4 :: Int -> Int -> Int (bound at T14590.hs:7:1) + seq :: forall a b. a -> b -> b + with seq @Int @Int + (imported from ‘Prelude’ at T14590.hs:1:8-13 + (and originally defined in ‘GHC.Prim’)) + (-) :: forall a. Num a => a -> a -> a + with (-) @Int + (imported from ‘Prelude’ at T14590.hs:1:8-13 + (and originally defined in ‘GHC.Num’)) + asTypeOf :: forall a. a -> a -> a + with asTypeOf @Int + (imported from ‘Prelude’ at T14590.hs:1:8-13 + (and originally defined in ‘GHC.Base’)) + const :: forall a b. a -> b -> a + with const @Int @Int + (imported from ‘Prelude’ at T14590.hs:1:8-13 + (and originally defined in ‘GHC.Base’)) + subtract :: forall a. Num a => a -> a -> a + with subtract @Int + (imported from ‘Prelude’ at T14590.hs:1:8-13 + (and originally defined in ‘GHC.Num’)) + (^) :: forall a b. (Num a, Integral b) => a -> b -> a + with (^) @Int @Int + (imported from ‘Prelude’ at T14590.hs:1:8-13 + (and originally defined in ‘GHC.Real’)) + gcd :: forall a. Integral a => a -> a -> a + with gcd @Int + (imported from ‘Prelude’ at T14590.hs:1:8-13 + (and originally defined in ‘GHC.Real’)) + lcm :: forall a. Integral a => a -> a -> a + with lcm @Int + (imported from ‘Prelude’ at T14590.hs:1:8-13 + (and originally defined in ‘GHC.Real’)) + (*) :: forall a. Num a => a -> a -> a + with (*) @Int + (imported from ‘Prelude’ at T14590.hs:1:8-13 + (and originally defined in ‘GHC.Num’)) + (+) :: forall a. Num a => a -> a -> a + with (+) @Int + (imported from ‘Prelude’ at T14590.hs:1:8-13 + (and originally defined in ‘GHC.Num’)) + div :: forall a. Integral a => a -> a -> a + with div @Int + (imported from ‘Prelude’ at T14590.hs:1:8-13 + (and originally defined in ‘GHC.Real’)) + mod :: forall a. Integral a => a -> a -> a + with mod @Int + (imported from ‘Prelude’ at T14590.hs:1:8-13 + (and originally defined in ‘GHC.Real’)) + quot :: forall a. Integral a => a -> a -> a + with quot @Int + (imported from ‘Prelude’ at T14590.hs:1:8-13 + (and originally defined in ‘GHC.Real’)) + rem :: forall a. Integral a => a -> a -> a + with rem @Int + (imported from ‘Prelude’ at T14590.hs:1:8-13 + (and originally defined in ‘GHC.Real’)) + max :: forall a. Ord a => a -> a -> a + with max @Int + (imported from ‘Prelude’ at T14590.hs:1:8-13 + (and originally defined in ‘GHC.Classes’)) + min :: forall a. Ord a => a -> a -> a + with min @Int + (imported from ‘Prelude’ at T14590.hs:1:8-13 + (and originally defined in ‘GHC.Classes’)) + return :: forall (m :: * -> *) a. Monad m => a -> m a + with return @((->) Int) @Int + (imported from ‘Prelude’ at T14590.hs:1:8-13 + (and originally defined in ‘GHC.Base’)) + pure :: forall (f :: * -> *) a. Applicative f => a -> f a + with pure @((->) Int) @Int + (imported from ‘Prelude’ at T14590.hs:1:8-13 + (and originally defined in ‘GHC.Base’)) + +T14590.hs:5:13: warning: [-Wtyped-holes (in -Wdefault)] + • Found hole: _a :: Int -> Int -> Int + Or perhaps ‘_a’ is mis-spelled, or not in scope + • In the expression: _a + In the expression: x `_a` + In the expression: (x `_a`) y + • Relevant bindings include + y :: Int (bound at T14590.hs:5:6) + x :: Int (bound at T14590.hs:5:4) + f2 :: Int -> Int -> Int (bound at T14590.hs:5:1) + Valid hole fits include + f2 :: Int -> Int -> Int (bound at T14590.hs:5:1) + f1 :: Int -> Int -> Int (defined at T14590.hs:4:1) + f3 :: Int -> Int -> Int (bound at T14590.hs:6:1) + f4 :: Int -> Int -> Int (bound at T14590.hs:7:1) + seq :: forall a b. a -> b -> b + with seq @Int @Int + (imported from ‘Prelude’ at T14590.hs:1:8-13 + (and originally defined in ‘GHC.Prim’)) + (-) :: forall a. Num a => a -> a -> a + with (-) @Int + (imported from ‘Prelude’ at T14590.hs:1:8-13 + (and originally defined in ‘GHC.Num’)) + asTypeOf :: forall a. a -> a -> a + with asTypeOf @Int + (imported from ‘Prelude’ at T14590.hs:1:8-13 + (and originally defined in ‘GHC.Base’)) + const :: forall a b. a -> b -> a + with const @Int @Int + (imported from ‘Prelude’ at T14590.hs:1:8-13 + (and originally defined in ‘GHC.Base’)) + subtract :: forall a. Num a => a -> a -> a + with subtract @Int + (imported from ‘Prelude’ at T14590.hs:1:8-13 + (and originally defined in ‘GHC.Num’)) + (^) :: forall a b. (Num a, Integral b) => a -> b -> a + with (^) @Int @Int + (imported from ‘Prelude’ at T14590.hs:1:8-13 + (and originally defined in ‘GHC.Real’)) + gcd :: forall a. Integral a => a -> a -> a + with gcd @Int + (imported from ‘Prelude’ at T14590.hs:1:8-13 + (and originally defined in ‘GHC.Real’)) + lcm :: forall a. Integral a => a -> a -> a + with lcm @Int + (imported from ‘Prelude’ at T14590.hs:1:8-13 + (and originally defined in ‘GHC.Real’)) + (*) :: forall a. Num a => a -> a -> a + with (*) @Int + (imported from ‘Prelude’ at T14590.hs:1:8-13 + (and originally defined in ‘GHC.Num’)) + (+) :: forall a. Num a => a -> a -> a + with (+) @Int + (imported from ‘Prelude’ at T14590.hs:1:8-13 + (and originally defined in ‘GHC.Num’)) + div :: forall a. Integral a => a -> a -> a + with div @Int + (imported from ‘Prelude’ at T14590.hs:1:8-13 + (and originally defined in ‘GHC.Real’)) + mod :: forall a. Integral a => a -> a -> a + with mod @Int + (imported from ‘Prelude’ at T14590.hs:1:8-13 + (and originally defined in ‘GHC.Real’)) + quot :: forall a. Integral a => a -> a -> a + with quot @Int + (imported from ‘Prelude’ at T14590.hs:1:8-13 + (and originally defined in ‘GHC.Real’)) + rem :: forall a. Integral a => a -> a -> a + with rem @Int + (imported from ‘Prelude’ at T14590.hs:1:8-13 + (and originally defined in ‘GHC.Real’)) + max :: forall a. Ord a => a -> a -> a + with max @Int + (imported from ‘Prelude’ at T14590.hs:1:8-13 + (and originally defined in ‘GHC.Classes’)) + min :: forall a. Ord a => a -> a -> a + with min @Int + (imported from ‘Prelude’ at T14590.hs:1:8-13 + (and originally defined in ‘GHC.Classes’)) + return :: forall (m :: * -> *) a. Monad m => a -> m a + with return @((->) Int) @Int + (imported from ‘Prelude’ at T14590.hs:1:8-13 + (and originally defined in ‘GHC.Base’)) + pure :: forall (f :: * -> *) a. Applicative f => a -> f a + with pure @((->) Int) @Int + (imported from ‘Prelude’ at T14590.hs:1:8-13 + (and originally defined in ‘GHC.Base’)) + +T14590.hs:6:11: warning: [-Wtyped-holes (in -Wdefault)] + • Found hole: _ :: Int -> Int -> Int + • In the expression: _ + In the expression: `_` x + In the expression: (`_` x) y + • Relevant bindings include + y :: Int (bound at T14590.hs:6:6) + x :: Int (bound at T14590.hs:6:4) + f3 :: Int -> Int -> Int (bound at T14590.hs:6:1) + Valid hole fits include + f3 :: Int -> Int -> Int (bound at T14590.hs:6:1) + f1 :: Int -> Int -> Int (defined at T14590.hs:4:1) + f2 :: Int -> Int -> Int (defined at T14590.hs:5:1) + f4 :: Int -> Int -> Int (bound at T14590.hs:7:1) + seq :: forall a b. a -> b -> b + with seq @Int @Int + (imported from ‘Prelude’ at T14590.hs:1:8-13 + (and originally defined in ‘GHC.Prim’)) + (-) :: forall a. Num a => a -> a -> a + with (-) @Int + (imported from ‘Prelude’ at T14590.hs:1:8-13 + (and originally defined in ‘GHC.Num’)) + asTypeOf :: forall a. a -> a -> a + with asTypeOf @Int + (imported from ‘Prelude’ at T14590.hs:1:8-13 + (and originally defined in ‘GHC.Base’)) + const :: forall a b. a -> b -> a + with const @Int @Int + (imported from ‘Prelude’ at T14590.hs:1:8-13 + (and originally defined in ‘GHC.Base’)) + subtract :: forall a. Num a => a -> a -> a + with subtract @Int + (imported from ‘Prelude’ at T14590.hs:1:8-13 + (and originally defined in ‘GHC.Num’)) + (^) :: forall a b. (Num a, Integral b) => a -> b -> a + with (^) @Int @Int + (imported from ‘Prelude’ at T14590.hs:1:8-13 + (and originally defined in ‘GHC.Real’)) + gcd :: forall a. Integral a => a -> a -> a + with gcd @Int + (imported from ‘Prelude’ at T14590.hs:1:8-13 + (and originally defined in ‘GHC.Real’)) + lcm :: forall a. Integral a => a -> a -> a + with lcm @Int + (imported from ‘Prelude’ at T14590.hs:1:8-13 + (and originally defined in ‘GHC.Real’)) + (*) :: forall a. Num a => a -> a -> a + with (*) @Int + (imported from ‘Prelude’ at T14590.hs:1:8-13 + (and originally defined in ‘GHC.Num’)) + (+) :: forall a. Num a => a -> a -> a + with (+) @Int + (imported from ‘Prelude’ at T14590.hs:1:8-13 + (and originally defined in ‘GHC.Num’)) + div :: forall a. Integral a => a -> a -> a + with div @Int + (imported from ‘Prelude’ at T14590.hs:1:8-13 + (and originally defined in ‘GHC.Real’)) + mod :: forall a. Integral a => a -> a -> a + with mod @Int + (imported from ‘Prelude’ at T14590.hs:1:8-13 + (and originally defined in ‘GHC.Real’)) + quot :: forall a. Integral a => a -> a -> a + with quot @Int + (imported from ‘Prelude’ at T14590.hs:1:8-13 + (and originally defined in ‘GHC.Real’)) + rem :: forall a. Integral a => a -> a -> a + with rem @Int + (imported from ‘Prelude’ at T14590.hs:1:8-13 + (and originally defined in ‘GHC.Real’)) + max :: forall a. Ord a => a -> a -> a + with max @Int + (imported from ‘Prelude’ at T14590.hs:1:8-13 + (and originally defined in ‘GHC.Classes’)) + min :: forall a. Ord a => a -> a -> a + with min @Int + (imported from ‘Prelude’ at T14590.hs:1:8-13 + (and originally defined in ‘GHC.Classes’)) + return :: forall (m :: * -> *) a. Monad m => a -> m a + with return @((->) Int) @Int + (imported from ‘Prelude’ at T14590.hs:1:8-13 + (and originally defined in ‘GHC.Base’)) + pure :: forall (f :: * -> *) a. Applicative f => a -> f a + with pure @((->) Int) @Int + (imported from ‘Prelude’ at T14590.hs:1:8-13 + (and originally defined in ‘GHC.Base’)) + +T14590.hs:7:11: warning: [-Wtyped-holes (in -Wdefault)] + • Found hole: _a :: Int -> Int -> Int + Or perhaps ‘_a’ is mis-spelled, or not in scope + • In the expression: _a + In the expression: `_a` x + In the expression: (`_a` x) y + • Relevant bindings include + y :: Int (bound at T14590.hs:7:6) + x :: Int (bound at T14590.hs:7:4) + f4 :: Int -> Int -> Int (bound at T14590.hs:7:1) + Valid hole fits include + f4 :: Int -> Int -> Int (bound at T14590.hs:7:1) + f1 :: Int -> Int -> Int (defined at T14590.hs:4:1) + f2 :: Int -> Int -> Int (defined at T14590.hs:5:1) + f3 :: Int -> Int -> Int (defined at T14590.hs:6:1) + seq :: forall a b. a -> b -> b + with seq @Int @Int + (imported from ‘Prelude’ at T14590.hs:1:8-13 + (and originally defined in ‘GHC.Prim’)) + (-) :: forall a. Num a => a -> a -> a + with (-) @Int + (imported from ‘Prelude’ at T14590.hs:1:8-13 + (and originally defined in ‘GHC.Num’)) + asTypeOf :: forall a. a -> a -> a + with asTypeOf @Int + (imported from ‘Prelude’ at T14590.hs:1:8-13 + (and originally defined in ‘GHC.Base’)) + const :: forall a b. a -> b -> a + with const @Int @Int + (imported from ‘Prelude’ at T14590.hs:1:8-13 + (and originally defined in ‘GHC.Base’)) + subtract :: forall a. Num a => a -> a -> a + with subtract @Int + (imported from ‘Prelude’ at T14590.hs:1:8-13 + (and originally defined in ‘GHC.Num’)) + (^) :: forall a b. (Num a, Integral b) => a -> b -> a + with (^) @Int @Int + (imported from ‘Prelude’ at T14590.hs:1:8-13 + (and originally defined in ‘GHC.Real’)) + gcd :: forall a. Integral a => a -> a -> a + with gcd @Int + (imported from ‘Prelude’ at T14590.hs:1:8-13 + (and originally defined in ‘GHC.Real’)) + lcm :: forall a. Integral a => a -> a -> a + with lcm @Int + (imported from ‘Prelude’ at T14590.hs:1:8-13 + (and originally defined in ‘GHC.Real’)) + (*) :: forall a. Num a => a -> a -> a + with (*) @Int + (imported from ‘Prelude’ at T14590.hs:1:8-13 + (and originally defined in ‘GHC.Num’)) + (+) :: forall a. Num a => a -> a -> a + with (+) @Int + (imported from ‘Prelude’ at T14590.hs:1:8-13 + (and originally defined in ‘GHC.Num’)) + div :: forall a. Integral a => a -> a -> a + with div @Int + (imported from ‘Prelude’ at T14590.hs:1:8-13 + (and originally defined in ‘GHC.Real’)) + mod :: forall a. Integral a => a -> a -> a + with mod @Int + (imported from ‘Prelude’ at T14590.hs:1:8-13 + (and originally defined in ‘GHC.Real’)) + quot :: forall a. Integral a => a -> a -> a + with quot @Int + (imported from ‘Prelude’ at T14590.hs:1:8-13 + (and originally defined in ‘GHC.Real’)) + rem :: forall a. Integral a => a -> a -> a + with rem @Int + (imported from ‘Prelude’ at T14590.hs:1:8-13 + (and originally defined in ‘GHC.Real’)) + max :: forall a. Ord a => a -> a -> a + with max @Int + (imported from ‘Prelude’ at T14590.hs:1:8-13 + (and originally defined in ‘GHC.Classes’)) + min :: forall a. Ord a => a -> a -> a + with min @Int + (imported from ‘Prelude’ at T14590.hs:1:8-13 + (and originally defined in ‘GHC.Classes’)) + return :: forall (m :: * -> *) a. Monad m => a -> m a + with return @((->) Int) @Int + (imported from ‘Prelude’ at T14590.hs:1:8-13 + (and originally defined in ‘GHC.Base’)) + pure :: forall (f :: * -> *) a. Applicative f => a -> f a + with pure @((->) Int) @Int + (imported from ‘Prelude’ at T14590.hs:1:8-13 + (and originally defined in ‘GHC.Base’)) diff --git a/testsuite/tests/typecheck/should_compile/T14732.hs b/testsuite/tests/typecheck/should_compile/T14732.hs new file mode 100644 index 0000000000..4fa070ed09 --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/T14732.hs @@ -0,0 +1,34 @@ +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# OPTIONS_GHC -fdefer-type-errors -O #-} +-- Oddly this bug was only triggered with -fdefer-type-errors +-- The -O ensures that the RULE is processed + +module T14732 where + +import Prelude hiding (zip, zipWith) + +zipWith :: (a -> b -> c) + -> Bundle v a + -> Bundle v b + -> Bundle v c +zipWith = undefined + +class GVector (v :: * -> *) a +instance GVector Vector a + +data Bundle (v :: * -> *) a +data Vector a +class Unbox a + +stream :: GVector v a => v a -> Bundle v a +{-# INLINE [1] stream #-} +stream = undefined + +zip :: (Unbox a, Unbox b) => Vector a -> Vector b -> Vector (a, b) +{-# INLINE [1] zip #-} +zip = undefined +{-# RULES "stream/zip [Vector.Unboxed]" forall as bs . + stream (zip as bs) = zipWith (,) (stream as) + (stream bs) #-} diff --git a/testsuite/tests/typecheck/should_compile/T14735.hs b/testsuite/tests/typecheck/should_compile/T14735.hs new file mode 100644 index 0000000000..c48231b7c2 --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/T14735.hs @@ -0,0 +1,30 @@ +{-# Language QuantifiedConstraints #-} +{-# Language StandaloneDeriving #-} +{-# Language DataKinds #-} +{-# Language TypeOperators #-} +{-# Language GADTs #-} +{-# Language KindSignatures #-} +{-# Language FlexibleInstances #-} +{-# Language UndecidableInstances #-} +{-# Language MultiParamTypeClasses #-} +{-# Language RankNTypes #-} +{-# Language ConstraintKinds #-} + +module T14735 where + +import Data.Kind + +data D c where + D :: c => D c + +newtype a :- b = S (a => D b) + +class C1 a b +class C2 a b +instance C1 a b => C2 a b + +class (forall xx. f xx) => Limit f +instance (forall xx. f xx) => Limit f + +impl :: Limit (C1 a) :- Limit (C2 a) +impl = S D diff --git a/testsuite/tests/typecheck/should_compile/T14763.hs b/testsuite/tests/typecheck/should_compile/T14763.hs new file mode 100644 index 0000000000..1af13f65cb --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/T14763.hs @@ -0,0 +1,34 @@ +{-# LANGUAGE FunctionalDependencies #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE MultiParamTypeClasses #-} +module T14763 where + +data Value a = Value a + +data SomeValue expr where + SomeValue :: Esqueleto query expr backend => expr (Value a) -> SomeValue expr + +class Esqueleto (query :: * -> *) (expr :: * -> *) backend + | query -> expr backend, expr -> query backend + +data SqlQuery a + +data SqlBackend + +data SqlExpr a where + ECompositeKey :: SqlExpr (Value a) + +instance Esqueleto SqlQuery SqlExpr SqlBackend + +match' :: SomeValue SqlExpr -> a +match' (SomeValue ECompositeKey) = undefined + +-- This is tricky becauuse we get a Given constraint +-- [G] Esqueleto query SqlExpr backend +-- where query and backend are existential. +-- Then fundeps with the top-level instance specify +-- [D] query ~ SqlQuery +-- [D] backend ~ SqlBackend +-- And that is not an error! +-- (Nor can we exploit it, though.) diff --git a/testsuite/tests/typecheck/should_compile/T14774.hs b/testsuite/tests/typecheck/should_compile/T14774.hs new file mode 100644 index 0000000000..ed45e07d47 --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/T14774.hs @@ -0,0 +1,13 @@ +{-# LANGUAGE UndecidableSuperClasses #-} + +module T14774 where + +class C a => D a where + cop :: a -> Bool + +class D a => C a where + dop :: a -> a + +f :: C a => Int -> a -> Bool +f 0 x = cop x +f n x = f (n-1) x diff --git a/testsuite/tests/typecheck/should_compile/T14774.stdout b/testsuite/tests/typecheck/should_compile/T14774.stdout new file mode 100644 index 0000000000..e98489e760 --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/T14774.stdout @@ -0,0 +1,3 @@ +T14774.$p1D :: forall a. D a => C a + RULES: Built in rule for T14774.$p1D: "Class op $p1D"] +T14774.$p1D diff --git a/testsuite/tests/typecheck/should_compile/T14811.hs b/testsuite/tests/typecheck/should_compile/T14811.hs new file mode 100644 index 0000000000..20c6ab9db1 --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/T14811.hs @@ -0,0 +1,5 @@ +{-# language UnboxedTuples #-} +module T14811 where + +data Foo a = Foo (# a #) +data Bar = Bar (# #) diff --git a/testsuite/tests/typecheck/should_compile/T14934.hs b/testsuite/tests/typecheck/should_compile/T14934.hs new file mode 100644 index 0000000000..581e93186e --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/T14934.hs @@ -0,0 +1,9 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE TypeOperators #-} +module T14934 where + +import T14934a +import GHC.TypeLits + +g :: Foo (1 - 0) +g = f MkFoo1 diff --git a/testsuite/tests/typecheck/should_compile/T14934a.hs b/testsuite/tests/typecheck/should_compile/T14934a.hs new file mode 100644 index 0000000000..3a4865fffc --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/T14934a.hs @@ -0,0 +1,15 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE TypeOperators #-} +module T14934a where + +import Data.Kind (Type) +import GHC.TypeLits + +data Foo :: Nat -> Type where + MkFoo0 :: Foo 0 + MkFoo1 :: Foo 1 + +f :: Foo (1 - 0) -> Foo 1 +f x = x diff --git a/testsuite/tests/typecheck/should_compile/T15050.hs b/testsuite/tests/typecheck/should_compile/T15050.hs new file mode 100644 index 0000000000..ed5f095274 --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/T15050.hs @@ -0,0 +1,21 @@ +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE GADTs #-} +module T15050 where +data P a = P +data T1 a where + MkT1a :: forall a. P a -> T1 a + MkT1b :: forall a. P a -> T1 a + MkT1c :: forall a. P a -> T1 a + MkT2 :: forall a. P a -> T1 (a,a) + MkT3 :: forall a b. b ~ Int => P a -> P b -> T1 a + MkT4 :: forall a b. P a -> P b -> T1 a + MkT5 :: forall a b c. b ~ c => P a -> P b -> P c -> T1 a + +foo :: T1 (Int, Int) -> () +foo (MkT1a (P::P (Int,Int))) = () +foo (MkT1b (P::P (Int,x))) = (() :: x ~ Int => ()) +foo (MkT1c (P::P x)) = (() :: x ~ (Int,Int) => ()) +foo (MkT2 (P::P x)) = (() :: x ~ Int => ()) +foo (MkT3 P (P::P Int)) = () +foo (MkT4 P (P::P b)) = () +foo (MkT5 P (P::P b) (P::P b)) = () diff --git a/testsuite/tests/typecheck/should_compile/T15141.hs b/testsuite/tests/typecheck/should_compile/T15141.hs new file mode 100644 index 0000000000..c0cb5d8488 --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/T15141.hs @@ -0,0 +1,35 @@ +{-# LANGUAGE PolyKinds, TypeFamilies, TypeFamilyDependencies, + ScopedTypeVariables, TypeOperators, GADTs, + DataKinds #-} + +module T15141 where + +import Data.Type.Equality +import Data.Proxy + +type family F a = r | r -> a where + F () = Bool + +data Wumpus where + Unify :: k1 ~ F k2 => k1 -> k2 -> Wumpus + +f :: forall k (a :: k). k :~: Bool -> () +f Refl = let x :: Proxy ('Unify a b) + x = undefined + in () + +{- +We want this situation: + +forall[1] k[1]. + [G] k ~ Bool + forall [2] ... . [W] k ~ F kappa[2] + +where the inner wanted can be solved only by taking the outer +given into account. This means that the wanted needs to be floated out. +More germane to this bug, we need *not* to generalize over kappa. + +The code above builds this scenario fairly exactly, and indeed fails +without the logic in kindGeneralize that excludes constrained variables +from generalization. +-} diff --git a/testsuite/tests/typecheck/should_compile/T15180.hs b/testsuite/tests/typecheck/should_compile/T15180.hs new file mode 100644 index 0000000000..a81f130093 --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/T15180.hs @@ -0,0 +1,11 @@ +{-# LANGUAGE MagicHash #-} +module Main where + +import Control.Exception +import System.Exit +import GHC.Exts + +main :: IO () +main = do + let a = throw $ toException ExitSuccess :: Int# + return () diff --git a/testsuite/tests/typecheck/should_compile/T15232.hs b/testsuite/tests/typecheck/should_compile/T15232.hs new file mode 100644 index 0000000000..ec7659ac38 --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/T15232.hs @@ -0,0 +1,12 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE UndecidableInstances #-} +{-# OPTIONS_GHC -Wredundant-constraints -Wall -Werror #-} +import GHC.TypeLits (TypeError, ErrorMessage(..)) + +class C a where f :: a -> a +instance {-# OVERLAPPING #-} C Int where f _ = 42 +instance {-# OVERLAPPABLE #-} TypeError ( 'Text "Only Int is supported" ) => C a where f = undefined + +main :: IO () +main = print $ f (42::Int) diff --git a/testsuite/tests/typecheck/should_compile/T15242.hs b/testsuite/tests/typecheck/should_compile/T15242.hs new file mode 100644 index 0000000000..aa95139337 --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/T15242.hs @@ -0,0 +1,6 @@ +{-# OPTIONS_GHC -ddump-tc-ast #-} + +module T15242 where + +f = (((const) 3)) ((((seq) 'a')) 'b') +g = ((((((((((id id)) id) id) id))) id))) id diff --git a/testsuite/tests/typecheck/should_compile/T15242.stderr b/testsuite/tests/typecheck/should_compile/T15242.stderr new file mode 100644 index 0000000000..0435a644f8 --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/T15242.stderr @@ -0,0 +1,34 @@ +({ T15242.hs:6:5-41 } +(HsPar +({ T15242.hs:6:6-40 } +(HsPar +({ T15242.hs:6:7-39 } +(HsPar +({ T15242.hs:6:8-35 } +(HsPar +({ T15242.hs:6:9-34 } +(HsPar +({ T15242.hs:6:10-33 } +(HsPar +({ T15242.hs:6:11-29 } +(HsPar +({ T15242.hs:6:12-25 } +(HsPar +({ T15242.hs:6:13-21 } +(HsPar +({ T15242.hs:6:14-20 } +(HsPar +({ T15242.hs:5:5-17 } +(HsPar +({ T15242.hs:5:6-16 } +(HsPar +({ T15242.hs:5:7-13 } +(HsPar +({ T15242.hs:5:19-37 } +(HsPar +({ T15242.hs:5:20-32 } +(HsPar +({ T15242.hs:5:21-31 } +(HsPar +({ T15242.hs:5:22-26 } +(HsPar diff --git a/testsuite/tests/typecheck/should_compile/T15368.hs b/testsuite/tests/typecheck/should_compile/T15368.hs new file mode 100644 index 0000000000..2db485740f --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/T15368.hs @@ -0,0 +1,11 @@ +{-# LANGUAGE TypeFamilies #-} + +module T15368 where + +transitive :: (a, b) -> (b, c) -> (a, c) +transitive = undefined + +trigger :: a -> b -> (F a b, F b a) +trigger _ _ = _ `transitive` trigger _ _ + +type family F (n :: *) (m :: *) :: * diff --git a/testsuite/tests/typecheck/should_compile/T15368.stderr b/testsuite/tests/typecheck/should_compile/T15368.stderr new file mode 100644 index 0000000000..36650d0506 --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/T15368.stderr @@ -0,0 +1,45 @@ + +T15368.hs:9:15: warning: [-Wtyped-holes (in -Wdefault)] + • Found hole: _ :: (F a b, F a0 b0) + Where: ‘a0’ is an ambiguous type variable + ‘b0’ is an ambiguous type variable + ‘a’, ‘b’ are rigid type variables bound by + the type signature for: + trigger :: forall a b. a -> b -> (F a b, F b a) + at T15368.hs:8:1-35 + • In the first argument of ‘transitive’, namely ‘_’ + In the expression: _ `transitive` trigger _ _ + In an equation for ‘trigger’: + trigger _ _ = _ `transitive` trigger _ _ + • Relevant bindings include + trigger :: a -> b -> (F a b, F b a) (bound at T15368.hs:9:1) + +T15368.hs:9:15: warning: [-Wdeferred-type-errors (in -Wdefault)] + • Couldn't match type ‘F b a’ with ‘F b0 a0’ + Expected type: (F a b, F b a) + Actual type: (F a b, F b0 a0) + NB: ‘F’ is a non-injective type family + The type variables ‘b0’, ‘a0’ are ambiguous + • In the expression: _ `transitive` trigger _ _ + In an equation for ‘trigger’: + trigger _ _ = _ `transitive` trigger _ _ + • Relevant bindings include + trigger :: a -> b -> (F a b, F b a) (bound at T15368.hs:9:1) + +T15368.hs:9:38: warning: [-Wtyped-holes (in -Wdefault)] + • Found hole: _ :: a0 + Where: ‘a0’ is an ambiguous type variable + • In the first argument of ‘trigger’, namely ‘_’ + In the second argument of ‘transitive’, namely ‘trigger _ _’ + In the expression: _ `transitive` trigger _ _ + • Relevant bindings include + trigger :: a -> b -> (F a b, F b a) (bound at T15368.hs:9:1) + +T15368.hs:9:40: warning: [-Wtyped-holes (in -Wdefault)] + • Found hole: _ :: b0 + Where: ‘b0’ is an ambiguous type variable + • In the second argument of ‘trigger’, namely ‘_’ + In the second argument of ‘transitive’, namely ‘trigger _ _’ + In the expression: _ `transitive` trigger _ _ + • Relevant bindings include + trigger :: a -> b -> (F a b, F b a) (bound at T15368.hs:9:1) diff --git a/testsuite/tests/typecheck/should_compile/T15370.hs b/testsuite/tests/typecheck/should_compile/T15370.hs new file mode 100644 index 0000000000..acccf030bd --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/T15370.hs @@ -0,0 +1,20 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeOperators #-} +module Bug where + +import Data.Type.Equality + +data S (a :: Either x y) + +mkRefl :: n :~: j +mkRefl = Refl + +right :: forall (r :: Either x y). + S r -> () +right no = + case mkRefl @x @y of + Refl -> no + _ diff --git a/testsuite/tests/typecheck/should_compile/T15370.stderr b/testsuite/tests/typecheck/should_compile/T15370.stderr new file mode 100644 index 0000000000..f26cf92c3d --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/T15370.stderr @@ -0,0 +1,42 @@ + +T15370.hs:14:10: warning: [-Wdeferred-type-errors (in -Wdefault)] + • Couldn't match type ‘n’ with ‘j’ + ‘n’ is a rigid type variable bound by + the type signature for: + mkRefl :: forall k (n :: k) (j :: k). n :~: j + at T15370.hs:13:1-17 + ‘j’ is a rigid type variable bound by + the type signature for: + mkRefl :: forall k (n :: k) (j :: k). n :~: j + at T15370.hs:13:1-17 + Expected type: n :~: j + Actual type: n :~: n + • In the expression: Refl + In an equation for ‘mkRefl’: mkRefl = Refl + • Relevant bindings include + mkRefl :: n :~: j (bound at T15370.hs:14:1) + +T15370.hs:20:13: warning: [-Wdeferred-type-errors (in -Wdefault)] + • Couldn't match type ‘S r’ with ‘()’ + Expected type: () + Actual type: S r + • In the expression: no + _ + In a case alternative: Refl -> no + _ + In the expression: case mkRefl @x @y of { Refl -> no + _ } + • Relevant bindings include + no :: S r (bound at T15370.hs:18:7) + right :: S r -> () (bound at T15370.hs:18:1) + +T15370.hs:20:18: warning: [-Wtyped-holes (in -Wdefault)] + • Found hole: _ :: S r + Where: ‘r’, ‘y’, ‘x’ are rigid type variables bound by + the type signature for: + right :: forall x y (r :: Either x y). S r -> () + at T15370.hs:(16,1)-(17,18) + • In the second argument of ‘(+)’, namely ‘_’ + In the expression: no + _ + In a case alternative: Refl -> no + _ + • Relevant bindings include + no :: S r (bound at T15370.hs:18:7) + right :: S r -> () (bound at T15370.hs:18:1) + Constraints include y ~ x (from T15370.hs:20:5-8) diff --git a/testsuite/tests/typecheck/should_compile/T15412.hs b/testsuite/tests/typecheck/should_compile/T15412.hs new file mode 100644 index 0000000000..6458ae0a74 --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/T15412.hs @@ -0,0 +1,17 @@ +{-# Language DataKinds, TypeInType, TypeFamilies, UndecidableInstances #-} + +module T15412 where + +import Data.Kind + +newtype I a = I a + +type C = Constraint + +type family + UnitC :: C where + UnitC = () + +instance UnitC => Functor I where + -- The UnitC type family in the context needs UndecidableIntances + fmap = undefined diff --git a/testsuite/tests/typecheck/should_compile/T15428.hs b/testsuite/tests/typecheck/should_compile/T15428.hs new file mode 100644 index 0000000000..a9d1cdd3b3 --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/T15428.hs @@ -0,0 +1,9 @@ +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeInType #-} +module T15428 where + +data Flurmp +type family Pure (x :: a) :: f a + +type T = Pure Flurmp Flurmp diff --git a/testsuite/tests/typecheck/should_compile/T15431.hs b/testsuite/tests/typecheck/should_compile/T15431.hs new file mode 100644 index 0000000000..21fa4c4e38 --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/T15431.hs @@ -0,0 +1,15 @@ +{-# LANGUAGE GADTs, FlexibleContexts #-} + +module T15431 where + +import Data.Coerce + +data T t where + A :: Show (t a) => t a -> T t + B :: Coercible Int (t a) => t a -> T t + +f :: T t -> String +f (A t) = show t + +g :: T t -> Int +g (B t) = coerce t diff --git a/testsuite/tests/typecheck/should_compile/T15431a.hs b/testsuite/tests/typecheck/should_compile/T15431a.hs new file mode 100644 index 0000000000..cf5a831c37 --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/T15431a.hs @@ -0,0 +1,12 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE GADTs #-} +module T15431a where + +import Data.Coerce +import Data.Functor.Identity + +g1 :: Coercible (t a) Int => t a -> Int +g1 = coerce + +g2 :: Coercible Int (t a) => t a -> Int +g2 = coerce diff --git a/testsuite/tests/typecheck/should_compile/T15473.hs b/testsuite/tests/typecheck/should_compile/T15473.hs new file mode 100644 index 0000000000..d6bf57b812 --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/T15473.hs @@ -0,0 +1,12 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} +-- {-# LANGUAGE UndecidableInstances #-} +module Bug where + +type family Undefined :: k where {} + +type family LetInterleave xs t ts is (a_ahkO :: [a]) (a_ahkP :: [[a]]) :: [[a]] where + LetInterleave xs t ts is y z = Undefined y z + diff --git a/testsuite/tests/typecheck/should_compile/T15473.stderr b/testsuite/tests/typecheck/should_compile/T15473.stderr new file mode 100644 index 0000000000..6fdeaa115c --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/T15473.stderr @@ -0,0 +1,8 @@ + +T15473.hs:11:3: error: + • Variable ‘a’ occurs more often + in the type family application ‘Undefined’ + than in the instance head ‘LetInterleave xs t ts is y z’ + (Use UndecidableInstances to permit this) + • In the equations for closed type family ‘LetInterleave’ + In the type family declaration for ‘LetInterleave’ diff --git a/testsuite/tests/typecheck/should_compile/T15499.hs b/testsuite/tests/typecheck/should_compile/T15499.hs new file mode 100644 index 0000000000..653440aacc --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/T15499.hs @@ -0,0 +1,11 @@ +{-# LANGUAGE DataKinds, GADTs, KindSignatures #-} +module T15499 () +where + +data ADT (p :: Integer) where + ADT :: + { a :: a + , b :: Integer + } -> ADT p + +foo = undefined {b=undefined} diff --git a/testsuite/tests/typecheck/should_compile/T15586.hs b/testsuite/tests/typecheck/should_compile/T15586.hs new file mode 100644 index 0000000000..e8fd4f3bd2 --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/T15586.hs @@ -0,0 +1,12 @@ +{-# LANGUAGE GADTs #-} + +module STree where + +data STree a where + STreeIM :: { + l :: v a , + stree :: a + } -> STree a + +insert :: STree a -> STree a +insert s = s { stree = undefined } diff --git a/testsuite/tests/typecheck/should_compile/T2494.stderr b/testsuite/tests/typecheck/should_compile/T2494.stderr index 48b2221220..5cf4fde746 100644 --- a/testsuite/tests/typecheck/should_compile/T2494.stderr +++ b/testsuite/tests/typecheck/should_compile/T2494.stderr @@ -2,9 +2,11 @@ T2494.hs:15:14: error: • Couldn't match type ‘b’ with ‘a’ ‘b’ is a rigid type variable bound by - the RULE "foo/foo" at T2494.hs:14:16-62 + the RULE "foo/foo" + at T2494.hs:(12,1)-(15,33) ‘a’ is a rigid type variable bound by - the RULE "foo/foo" at T2494.hs:13:16-62 + the RULE "foo/foo" + at T2494.hs:(12,1)-(15,33) Expected type: Maybe (m a) -> Maybe (m a) Actual type: Maybe (m b) -> Maybe (m b) • In the first argument of ‘foo’, namely ‘g’ @@ -20,9 +22,11 @@ T2494.hs:15:14: error: T2494.hs:15:30: error: • Couldn't match type ‘b’ with ‘a’ ‘b’ is a rigid type variable bound by - the RULE "foo/foo" at T2494.hs:14:16-62 + the RULE "foo/foo" + at T2494.hs:(12,1)-(15,33) ‘a’ is a rigid type variable bound by - the RULE "foo/foo" at T2494.hs:13:16-62 + the RULE "foo/foo" + at T2494.hs:(12,1)-(15,33) Expected type: Maybe (m b) -> Maybe (m a) Actual type: Maybe (m b) -> Maybe (m b) • In the second argument of ‘(.)’, namely ‘g’ diff --git a/testsuite/tests/typecheck/should_compile/T2497.hs b/testsuite/tests/typecheck/should_compile/T2497.hs index 6f76395fbf..55c390dbed 100644 --- a/testsuite/tests/typecheck/should_compile/T2497.hs +++ b/testsuite/tests/typecheck/should_compile/T2497.hs @@ -6,7 +6,7 @@ foo x = x {-# NOINLINE [1] foo #-} -- Trac #2497; test should compile without language --- pragmas to swith on the forall +-- pragmas to switch on the forall {-# RULES "id" forall (x :: a). foo x = x #-} diff --git a/testsuite/tests/typecheck/should_compile/T7169.hs b/testsuite/tests/typecheck/should_compile/T7169.hs new file mode 100644 index 0000000000..ab1a7580d9 --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/T7169.hs @@ -0,0 +1,23 @@ +{-#OPTIONS_GHC -Wpartial-fields #-} +{-# LANGUAGE PatternSynonyms #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE GADTs #-} + + +module T7196 where + +data T a = A + { m1 :: a + , m2 :: a + , _m3 :: a + } | B + { + m1 :: a + } + +pattern P{x} = x + +data family F a +data instance F a where + F1 :: { f1 :: Int } -> F Int + F2 :: { f2 :: Int } -> F Char diff --git a/testsuite/tests/typecheck/should_compile/T7169.stderr b/testsuite/tests/typecheck/should_compile/T7169.stderr new file mode 100644 index 0000000000..0cc82e03cc --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/T7169.stderr @@ -0,0 +1,2 @@ +T7169.hs:11:5: warning: [-Wpartial-fields] + Use of partial record field selector: ‘m2’ diff --git a/testsuite/tests/typecheck/should_compile/T7220a.stderr b/testsuite/tests/typecheck/should_compile/T7220a.stderr index a1e865f131..2b311c1111 100644 --- a/testsuite/tests/typecheck/should_compile/T7220a.stderr +++ b/testsuite/tests/typecheck/should_compile/T7220a.stderr @@ -2,13 +2,13 @@ T7220a.hs:17:6: error: • Could not deduce (C a b) from the context: (C a0 b, TF b ~ Y) - bound by the type signature for: - f :: forall b. (C a0 b, TF b ~ Y) => b + bound by a type expected by the context: + forall b. (C a0 b, TF b ~ Y) => b at T7220a.hs:17:6-44 Possible fix: add (C a b) to the context of - the type signature for: - f :: forall b. (C a0 b, TF b ~ Y) => b + a type expected by the context: + forall b. (C a0 b, TF b ~ Y) => b • In the ambiguity check for ‘f’ To defer the ambiguity check to use sites, enable AllowAmbiguousTypes In the type signature: f :: (forall b. (C a b, TF b ~ Y) => b) -> X diff --git a/testsuite/tests/typecheck/should_compile/T9497a.stderr b/testsuite/tests/typecheck/should_compile/T9497a.stderr index ddbb5b93f6..d24849df79 100644 --- a/testsuite/tests/typecheck/should_compile/T9497a.stderr +++ b/testsuite/tests/typecheck/should_compile/T9497a.stderr @@ -5,3 +5,13 @@ T9497a.hs:2:8: warning: [-Wtyped-holes (in -Wdefault)] • In the expression: _main In an equation for ‘main’: main = _main • Relevant bindings include main :: IO () (bound at T9497a.hs:2:1) + Valid hole fits include + main :: IO () (bound at T9497a.hs:2:1) + readLn :: forall a. Read a => IO a + with readLn @() + (imported from ‘Prelude’ at T9497a.hs:1:1 + (and originally defined in ‘System.IO’)) + mempty :: forall a. Monoid a => a + with mempty @(IO ()) + (imported from ‘Prelude’ at T9497a.hs:1:1 + (and originally defined in ‘GHC.Base’)) diff --git a/testsuite/tests/typecheck/should_compile/T9834.stderr b/testsuite/tests/typecheck/should_compile/T9834.stderr index 01b003fa3a..52f207d511 100644 --- a/testsuite/tests/typecheck/should_compile/T9834.stderr +++ b/testsuite/tests/typecheck/should_compile/T9834.stderr @@ -19,17 +19,17 @@ T9834.hs:23:10: warning: [-Wdeferred-type-errors (in -Wdefault)] (bound at T9834.hs:23:3) T9834.hs:23:10: warning: [-Wdeferred-type-errors (in -Wdefault)] - • Couldn't match type ‘a’ with ‘a1’ + • Couldn't match type ‘a1’ with ‘a’ + ‘a1’ is a rigid type variable bound by + a type expected by the context: + forall (q :: * -> *). Applicative q => Nat (Comp p q) (Comp p q) + at T9834.hs:23:10-19 ‘a’ is a rigid type variable bound by the type signature for: afix :: forall a. (forall (q :: * -> *). Applicative q => Comp p q a -> Comp p q a) -> p a at T9834.hs:22:11-74 - ‘a1’ is a rigid type variable bound by - a type expected by the context: - forall (q :: * -> *). Applicative q => Nat (Comp p q) (Comp p q) - at T9834.hs:23:10-19 Expected type: Comp p q a1 -> Comp p q a1 Actual type: Comp p q a -> Comp p q a • In the expression: wrapIdComp diff --git a/testsuite/tests/typecheck/should_compile/TcCustomSolverSuper.hs b/testsuite/tests/typecheck/should_compile/TcCustomSolverSuper.hs index c401e1c446..b5e20be448 100644 --- a/testsuite/tests/typecheck/should_compile/TcCustomSolverSuper.hs +++ b/testsuite/tests/typecheck/should_compile/TcCustomSolverSuper.hs @@ -13,11 +13,17 @@ using the solver (see `tcSuperClasses` in `TcInstDecls`). However, some classes need to be excepted from this behavior, as they have custom solving rules, and this test checks that we got this right. + +PS: this test used to have Typeable in the context too, but + that's a redundant constraint, so I removed it + +PPS: the whole structre of tcSuperClasses has changed, + so I'm no longer sure what is being tested here -} -class (Typeable x, KnownNat x) => C x -class (Typeable x, KnownSymbol x) => D x +class (KnownNat x) => C x +class (KnownSymbol x) => D x instance C 2 instance D "2" diff --git a/testsuite/tests/typecheck/should_compile/TcTypeNatSimple.hs b/testsuite/tests/typecheck/should_compile/TcTypeNatSimple.hs index c692c3f725..d0077edbdb 100644 --- a/testsuite/tests/typecheck/should_compile/TcTypeNatSimple.hs +++ b/testsuite/tests/typecheck/should_compile/TcTypeNatSimple.hs @@ -1,6 +1,6 @@ {-# LANGUAGE DataKinds, TypeOperators, TypeFamilies #-} module TcTypeNatSimple where -import GHC.TypeLits +import GHC.TypeLits as L import Data.Proxy -------------------------------------------------------------------------------- @@ -8,7 +8,7 @@ import Data.Proxy e1 :: Proxy (2 + 3) -> Proxy 5 e1 = id -e2 :: Proxy (2 * 3) -> Proxy 6 +e2 :: Proxy (2 L.* 3) -> Proxy 6 e2 = id e3 :: Proxy (2 ^ 3) -> Proxy 8 @@ -20,16 +20,16 @@ e4 = id e5 :: Proxy (x + 0) -> Proxy x e5 = id -e6 :: Proxy (x * 0) -> Proxy 0 +e6 :: Proxy (x L.* 0) -> Proxy 0 e6 = id -e7 :: Proxy (0 * x) -> Proxy 0 +e7 :: Proxy (0 L.* x) -> Proxy 0 e7 = id -e8 :: Proxy (x * 1) -> Proxy x +e8 :: Proxy (x L.* 1) -> Proxy x e8 = id -e9 :: Proxy (1 * x) -> Proxy x +e9 :: Proxy (1 L.* x) -> Proxy x e9 = id e10 :: Proxy (x ^ 1) -> Proxy x @@ -59,6 +59,21 @@ e17 = id e18 :: Proxy (a - 0) -> Proxy a e18 = id +e19 :: Proxy (Div 10 3) -> Proxy 3 +e19 = id + +e20 :: Proxy (Div x 1) -> Proxy x +e20 = id + +e21 :: Proxy (Mod 10 3) -> Proxy 1 +e21 = id + +e22 :: Proxy (Mod x 1) -> Proxy 0 +e22 = id + +e23 :: Proxy (Log2 10) -> Proxy 3 +e23 = id + -------------------------------------------------------------------------------- -- Test interactions with inerts @@ -68,10 +83,10 @@ e18 = id ti2 :: Proxy (y + x) -> Proxy x -> () ti2 _ _ = () -ti3 :: Proxy (2 * y) -> () +ti3 :: Proxy (2 L.* y) -> () ti3 _ = () -ti4 :: Proxy (y * 2) -> () +ti4 :: Proxy (y L.* 2) -> () ti4 _ = () ti5 :: Proxy (2 ^ y) -> () diff --git a/testsuite/tests/typecheck/should_compile/ValidHoleFits.hs b/testsuite/tests/typecheck/should_compile/ValidHoleFits.hs new file mode 100644 index 0000000000..c996d109fa --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/ValidHoleFits.hs @@ -0,0 +1,4 @@ +module ValidHoleFits where + + +data Moo = Moo Integer diff --git a/testsuite/tests/typecheck/should_compile/ValidSubs.hs b/testsuite/tests/typecheck/should_compile/ValidSubs.hs deleted file mode 100644 index 050b317d9d..0000000000 --- a/testsuite/tests/typecheck/should_compile/ValidSubs.hs +++ /dev/null @@ -1,4 +0,0 @@ -module ValidSubs where - - -data Moo = Moo Integer diff --git a/testsuite/tests/typecheck/should_compile/abstract_refinement_hole_fits.hs b/testsuite/tests/typecheck/should_compile/abstract_refinement_hole_fits.hs new file mode 100644 index 0000000000..4949632308 --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/abstract_refinement_hole_fits.hs @@ -0,0 +1,7 @@ +module AbstractRefinementSubstitutions where + +f :: [Integer] -> Integer +f = _ + +g :: [Integer] -> Integer +g = _ 0 diff --git a/testsuite/tests/typecheck/should_compile/abstract_refinement_hole_fits.stderr b/testsuite/tests/typecheck/should_compile/abstract_refinement_hole_fits.stderr new file mode 100644 index 0000000000..c5627f9769 --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/abstract_refinement_hole_fits.stderr @@ -0,0 +1,253 @@ + +abstract_refinement_hole_fits.hs:4:5: warning: [-Wtyped-holes (in -Wdefault)] + • Found hole: _ :: [Integer] -> Integer + • In the expression: _ + In an equation for ‘f’: f = _ + • Relevant bindings include + f :: [Integer] -> Integer + (bound at abstract_refinement_hole_fits.hs:4:1) + Valid hole fits include + f :: [Integer] -> Integer + g :: [Integer] -> Integer + head :: forall a. [a] -> a + last :: forall a. [a] -> a + maximum :: forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a + minimum :: forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a + product :: forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a + sum :: forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a + Valid refinement hole fits include + foldl1 (_ :: Integer -> Integer -> Integer) + where foldl1 :: forall (t :: * -> *) a. + Foldable t => + (a -> a -> a) -> t a -> a + foldr1 (_ :: Integer -> Integer -> Integer) + where foldr1 :: forall (t :: * -> *) a. + Foldable t => + (a -> a -> a) -> t a -> a + foldl (_ :: Integer -> Integer -> Integer) (_ :: Integer) + where foldl :: forall (t :: * -> *) b a. + Foldable t => + (b -> a -> b) -> b -> t a -> b + foldr (_ :: Integer -> Integer -> Integer) (_ :: Integer) + where foldr :: forall (t :: * -> *) a b. + Foldable t => + (a -> b -> b) -> b -> t a -> b + const (_ :: Integer) + where const :: forall a b. a -> b -> a + ($) (_ :: [Integer] -> Integer) + where ($) :: forall a b. (a -> b) -> a -> b + fail (_ :: String) + where fail :: forall (m :: * -> *) a. Monad m => String -> m a + return (_ :: Integer) + where return :: forall (m :: * -> *) a. Monad m => a -> m a + pure (_ :: Integer) + where pure :: forall (f :: * -> *) a. Applicative f => a -> f a + ($!) (_ :: [Integer] -> Integer) + where ($!) :: forall a b. (a -> b) -> a -> b + curry (_ :: (a2, [Integer]) -> Integer) (_ :: a2) + where curry :: forall a b c. ((a, b) -> c) -> a -> b -> c + (.) (_ :: b1 -> Integer) (_ :: [Integer] -> b1) + where (.) :: forall b c a. (b -> c) -> (a -> b) -> a -> c + flip (_ :: [Integer] -> b7 -> Integer) (_ :: b7) + where flip :: forall a b c. (a -> b -> c) -> b -> a -> c + (>>=) (_ :: [Integer] -> a11) (_ :: a11 -> [Integer] -> Integer) + where (>>=) :: forall (m :: * -> *) a b. + Monad m => + m a -> (a -> m b) -> m b + (>>) (_ :: [Integer] -> a10) (_ :: [Integer] -> Integer) + where (>>) :: forall (m :: * -> *) a b. + Monad m => + m a -> m b -> m b + fmap (_ :: a12 -> Integer) (_ :: [Integer] -> a12) + where fmap :: forall (f :: * -> *) a b. + Functor f => + (a -> b) -> f a -> f b + (<*>) (_ :: [Integer] -> a8 -> Integer) (_ :: [Integer] -> a8) + where (<*>) :: forall (f :: * -> *) a b. + Applicative f => + f (a -> b) -> f a -> f b + (*>) (_ :: [Integer] -> a7) (_ :: [Integer] -> Integer) + where (*>) :: forall (f :: * -> *) a b. + Applicative f => + f a -> f b -> f b + (<$>) (_ :: a1 -> Integer) (_ :: [Integer] -> a1) + where (<$>) :: forall (f :: * -> *) a b. + Functor f => + (a -> b) -> f a -> f b + (=<<) (_ :: a9 -> [Integer] -> Integer) (_ :: [Integer] -> a9) + where (=<<) :: forall (m :: * -> *) a b. + Monad m => + (a -> m b) -> m a -> m b + (<*) (_ :: [Integer] -> Integer) (_ :: [Integer] -> b5) + where (<*) :: forall (f :: * -> *) a b. + Applicative f => + f a -> f b -> f a + (<$) (_ :: Integer) (_ :: [Integer] -> b4) + where (<$) :: forall (f :: * -> *) a b. + Functor f => + a -> f b -> f a + id (_ :: t0 -> [Integer] -> Integer) (_ :: t0) + where id :: forall a. a -> a + head (_ :: [t0 -> [Integer] -> Integer]) (_ :: t0) + where head :: forall a. [a] -> a + last (_ :: [t0 -> [Integer] -> Integer]) (_ :: t0) + where last :: forall a. [a] -> a + fst (_ :: (t0 -> [Integer] -> Integer, b2)) (_ :: t0) + where fst :: forall a b. (a, b) -> a + snd (_ :: (a3, t0 -> [Integer] -> Integer)) (_ :: t0) + where snd :: forall a b. (a, b) -> b + id (_ :: [Integer] -> Integer) + where id :: forall a. a -> a + head (_ :: [[Integer] -> Integer]) + where head :: forall a. [a] -> a + last (_ :: [[Integer] -> Integer]) + where last :: forall a. [a] -> a + asTypeOf (_ :: [Integer] -> Integer) (_ :: [Integer] -> Integer) + where asTypeOf :: forall a. a -> a -> a + (!!) (_ :: [[Integer] -> Integer]) (_ :: Int) + where (!!) :: forall a. [a] -> Int -> a + fst (_ :: ([Integer] -> Integer, b0)) + where fst :: forall a b. (a, b) -> a + snd (_ :: (a0, [Integer] -> Integer)) + where snd :: forall a b. (a, b) -> b + seq (_ :: a13) (_ :: [Integer] -> Integer) + where seq :: forall a b. a -> b -> b + const (_ :: [Integer] -> Integer) (_ :: b6) + where const :: forall a b. a -> b -> a + ($) (_ :: a5 -> [Integer] -> Integer) (_ :: a5) + where ($) :: forall a b. (a -> b) -> a -> b + fail (_ :: String) (_ :: t0) + where fail :: forall (m :: * -> *) a. Monad m => String -> m a + return (_ :: [Integer] -> Integer) (_ :: t0) + where return :: forall (m :: * -> *) a. Monad m => a -> m a + pure (_ :: [Integer] -> Integer) (_ :: t0) + where pure :: forall (f :: * -> *) a. Applicative f => a -> f a + uncurry (_ :: a4 -> b3 -> [Integer] -> Integer) (_ :: (a4, b3)) + where uncurry :: forall a b c. (a -> b -> c) -> (a, b) -> c + ($!) (_ :: a6 -> [Integer] -> Integer) (_ :: a6) + where ($!) :: forall a b. (a -> b) -> a -> b + +abstract_refinement_hole_fits.hs:7:5: warning: [-Wtyped-holes (in -Wdefault)] + • Found hole: _ :: Integer -> [Integer] -> Integer + • In the expression: _ + In the expression: _ 0 + In an equation for ‘g’: g = _ 0 + • Relevant bindings include + g :: [Integer] -> Integer + (bound at abstract_refinement_hole_fits.hs:7:1) + Valid hole fits include + const :: forall a b. a -> b -> a + return :: forall (m :: * -> *) a. Monad m => a -> m a + pure :: forall (f :: * -> *) a. Applicative f => a -> f a + Valid refinement hole fits include + foldl (_ :: Integer -> Integer -> Integer) + where foldl :: forall (t :: * -> *) b a. + Foldable t => + (b -> a -> b) -> b -> t a -> b + foldr (_ :: Integer -> Integer -> Integer) + where foldr :: forall (t :: * -> *) a b. + Foldable t => + (a -> b -> b) -> b -> t a -> b + curry (_ :: (Integer, [Integer]) -> Integer) + where curry :: forall a b c. ((a, b) -> c) -> a -> b -> c + flip (_ :: [Integer] -> Integer -> Integer) + where flip :: forall a b c. (a -> b -> c) -> b -> a -> c + const (_ :: [Integer] -> Integer) + where const :: forall a b. a -> b -> a + ($) (_ :: Integer -> [Integer] -> Integer) + where ($) :: forall a b. (a -> b) -> a -> b + fail (_ :: String) + where fail :: forall (m :: * -> *) a. Monad m => String -> m a + return (_ :: [Integer] -> Integer) + where return :: forall (m :: * -> *) a. Monad m => a -> m a + pure (_ :: [Integer] -> Integer) + where pure :: forall (f :: * -> *) a. Applicative f => a -> f a + ($!) (_ :: Integer -> [Integer] -> Integer) + where ($!) :: forall a b. (a -> b) -> a -> b + curry (_ :: (a2, Integer) -> [Integer] -> Integer) (_ :: a2) + where curry :: forall a b c. ((a, b) -> c) -> a -> b -> c + (.) (_ :: b1 -> [Integer] -> Integer) (_ :: Integer -> b1) + where (.) :: forall b c a. (b -> c) -> (a -> b) -> a -> c + flip (_ :: Integer -> b7 -> [Integer] -> Integer) (_ :: b7) + where flip :: forall a b c. (a -> b -> c) -> b -> a -> c + (>>=) (_ :: Integer -> a11) + (_ :: a11 -> Integer -> [Integer] -> Integer) + where (>>=) :: forall (m :: * -> *) a b. + Monad m => + m a -> (a -> m b) -> m b + (>>) (_ :: Integer -> a10) (_ :: Integer -> [Integer] -> Integer) + where (>>) :: forall (m :: * -> *) a b. + Monad m => + m a -> m b -> m b + fmap (_ :: a12 -> [Integer] -> Integer) (_ :: Integer -> a12) + where fmap :: forall (f :: * -> *) a b. + Functor f => + (a -> b) -> f a -> f b + (<*>) (_ :: Integer -> a8 -> [Integer] -> Integer) + (_ :: Integer -> a8) + where (<*>) :: forall (f :: * -> *) a b. + Applicative f => + f (a -> b) -> f a -> f b + (*>) (_ :: Integer -> a7) (_ :: Integer -> [Integer] -> Integer) + where (*>) :: forall (f :: * -> *) a b. + Applicative f => + f a -> f b -> f b + (<$>) (_ :: a1 -> [Integer] -> Integer) (_ :: Integer -> a1) + where (<$>) :: forall (f :: * -> *) a b. + Functor f => + (a -> b) -> f a -> f b + (=<<) (_ :: a9 -> Integer -> [Integer] -> Integer) + (_ :: Integer -> a9) + where (=<<) :: forall (m :: * -> *) a b. + Monad m => + (a -> m b) -> m a -> m b + (<*) (_ :: Integer -> [Integer] -> Integer) (_ :: Integer -> b5) + where (<*) :: forall (f :: * -> *) a b. + Applicative f => + f a -> f b -> f a + (<$) (_ :: [Integer] -> Integer) (_ :: Integer -> b4) + where (<$) :: forall (f :: * -> *) a b. + Functor f => + a -> f b -> f a + id (_ :: t0 -> Integer -> [Integer] -> Integer) (_ :: t0) + where id :: forall a. a -> a + head (_ :: [t0 -> Integer -> [Integer] -> Integer]) (_ :: t0) + where head :: forall a. [a] -> a + last (_ :: [t0 -> Integer -> [Integer] -> Integer]) (_ :: t0) + where last :: forall a. [a] -> a + fst (_ :: (t0 -> Integer -> [Integer] -> Integer, b2)) (_ :: t0) + where fst :: forall a b. (a, b) -> a + snd (_ :: (a3, t0 -> Integer -> [Integer] -> Integer)) (_ :: t0) + where snd :: forall a b. (a, b) -> b + id (_ :: Integer -> [Integer] -> Integer) + where id :: forall a. a -> a + head (_ :: [Integer -> [Integer] -> Integer]) + where head :: forall a. [a] -> a + last (_ :: [Integer -> [Integer] -> Integer]) + where last :: forall a. [a] -> a + asTypeOf (_ :: Integer -> [Integer] -> Integer) + (_ :: Integer -> [Integer] -> Integer) + where asTypeOf :: forall a. a -> a -> a + (!!) (_ :: [Integer -> [Integer] -> Integer]) (_ :: Int) + where (!!) :: forall a. [a] -> Int -> a + fst (_ :: (Integer -> [Integer] -> Integer, b0)) + where fst :: forall a b. (a, b) -> a + snd (_ :: (a0, Integer -> [Integer] -> Integer)) + where snd :: forall a b. (a, b) -> b + seq (_ :: a13) (_ :: Integer -> [Integer] -> Integer) + where seq :: forall a b. a -> b -> b + const (_ :: Integer -> [Integer] -> Integer) (_ :: b6) + where const :: forall a b. a -> b -> a + ($) (_ :: a5 -> Integer -> [Integer] -> Integer) (_ :: a5) + where ($) :: forall a b. (a -> b) -> a -> b + fail (_ :: String) (_ :: t0) + where fail :: forall (m :: * -> *) a. Monad m => String -> m a + return (_ :: Integer -> [Integer] -> Integer) (_ :: t0) + where return :: forall (m :: * -> *) a. Monad m => a -> m a + pure (_ :: Integer -> [Integer] -> Integer) (_ :: t0) + where pure :: forall (f :: * -> *) a. Applicative f => a -> f a + uncurry (_ :: a4 -> b3 -> Integer -> [Integer] -> Integer) + (_ :: (a4, b3)) + where uncurry :: forall a b c. (a -> b -> c) -> (a, b) -> c + ($!) (_ :: a6 -> Integer -> [Integer] -> Integer) (_ :: a6) + where ($!) :: forall a b. (a -> b) -> a -> b diff --git a/testsuite/tests/typecheck/should_compile/all.T b/testsuite/tests/typecheck/should_compile/all.T index 2ce4e91fa8..b9cb68eb63 100644 --- a/testsuite/tests/typecheck/should_compile/all.T +++ b/testsuite/tests/typecheck/should_compile/all.T @@ -165,7 +165,7 @@ test('tc161', normal, compile, ['']) test('tc162', normal, compile, ['']) test('tc163', normal, compile, ['']) test('tc164', normal, compile, ['']) -test('tc165', expect_broken_for(10181, ['optasm', 'optllvm']), compile, ['']) +test('tc165', normal, compile, ['']) test('tc166', normal, compile, ['']) test('tc167', normal, compile, ['']) test('tc168', normal, compile_fail, ['']) @@ -188,7 +188,7 @@ test('tc179', normal, compile, ['']) test('tc180', normal, compile, ['']) test('tc181', normal, compile, ['']) test('tc182', normal, compile, ['']) -test('tc183', reqlib('mtl'), compile, ['']) +test('tc183', normal, compile, ['']) test('tc184', normal, compile, ['']) test('tc185', normal, compile, ['']) test('tc186', normal, compile, ['']) @@ -225,13 +225,13 @@ test('tc215', normal, compile, ['']) # This one is very delicate, but I don't think the result really matters test('tc216', normal, compile, ['']) -test('tc217', reqlib('mtl'), compile, ['']) +test('tc217', normal, compile, ['']) test('tc218', normal, compile, ['']) test('tc219', normal, compile, ['']) -test('tc220', [reqlib('mtl'), reqlib('syb')], compile, ['']) +test('tc220', [reqlib('syb')], compile, ['']) test('tc221', normal, compile, ['']) test('tc222', normal, compile, ['']) -test('tc223', reqlib('mtl'), compile, ['']) +test('tc223', normal, compile, ['']) test('tc224', normal, compile, ['']) test('tc225', normal, compile, ['']) test('tc226', normal, compile, ['']) @@ -240,7 +240,7 @@ test('tc228', normal, compile, ['']) test('tc229', normal, compile, ['']) test('tc230', normal, compile, ['']) test('tc231', normal, compile, ['']) -test('tc232', reqlib('mtl'), compile, ['']) +test('tc232', normal, compile, ['']) test('tc233', normal, compile, ['']) test('tc234', normal, compile, ['']) test('tc235', normal, compile, ['']) @@ -305,7 +305,7 @@ test('T1123', normal, compile, ['']) test('T3692', normal, compile, ['']) test('T700', normal, compile, ['']) test('T4361', normal, compile, ['']) -test('T4355', reqlib('mtl'), compile, ['']) +test('T4355', normal, compile, ['']) test('T1634', normal, compile, ['']) test('T4401', normal, compile, ['']) test('T4404', normal, compile, ['-Wall']) @@ -337,7 +337,7 @@ test('tc260', normal, compile, ['']) test('tc261', normal, compile, ['']) test('tc262', normal, compile, ['']) test('tc263', [extra_files(['Tc263_Help.hs'])], multimod_compile, ['tc263', '-v0']) -test('tc265', compile_timeout_multiplier(0.01), compile, ['']) +test('tc265', normal, compile, ['']) test('tc266', [extra_files(['Tc266.hs', 'Tc266a.hs', 'Tc266.hs-boot'])], run_command, ['$MAKE -s --no-print-directory tc266']) test('Tc267', [extra_files(['Tc267a.hs', 'Tc267b.hs', 'Tc267a.hs-boot', 'Tc267b.hs-boot'])], run_command, ['$MAKE -s --no-print-directory Tc267']) test('tc268', normal, compile, ['']) @@ -383,13 +383,22 @@ test('T7050', normal, compile, ['-O']) test('T7312', normal, compile, ['']) test('T7384', normal, compile, ['']) test('T7451', normal, compile, ['']) -test('holes', normal, compile, ['-fdefer-type-errors']) -test('holes2', normal, compile, ['-fdefer-type-errors']) -test('holes3', normal, compile_fail, ['']) -test('hole_constraints', normal, compile, ['-fdefer-type-errors']) -test('hole_constraints_nested', normal, compile, ['-fdefer-type-errors']) -test('valid_substitutions', [extra_files(['ValidSubs.hs'])], - multimod_compile, ['valid_substitutions','-fdefer-type-errors']) +test('holes', normal, compile, ['-fdefer-type-errors -fno-max-valid-hole-fits -funclutter-valid-hole-fits']) +test('holes2', normal, compile, ['-fdefer-type-errors -fno-max-valid-hole-fits -funclutter-valid-hole-fits']) +test('holes3', normal, compile_fail, ['-fno-max-valid-hole-fits -funclutter-valid-hole-fits']) +test('hole_constraints', normal, compile, ['-fdefer-type-errors -fno-max-valid-hole-fits -funclutter-valid-hole-fits']) +test('hole_constraints_nested', normal, compile, ['-fdefer-type-errors -fno-max-valid-hole-fits -funclutter-valid-hole-fits']) +test('valid_hole_fits', [extra_files(['ValidHoleFits.hs'])], + multimod_compile, ['valid_hole_fits','-fdefer-type-errors -fno-max-valid-hole-fits']) +test('local_hole_fits', normal, compile, ['-fdefer-type-errors -fno-max-valid-hole-fits']) +test('subsumption_sort_hole_fits', normal, compile, ['-fdefer-type-errors -fno-max-valid-hole-fits -fsort-by-subsumption-hole-fits']) +test('valid_hole_fits_interactions', normal, compile, ['-fdefer-type-errors -fno-max-valid-hole-fits']) +test('refinement_hole_fits', normal, compile, ['-fdefer-type-errors -fno-max-valid-hole-fits -fno-max-refinement-hole-fits -frefinement-level-hole-fits=2']) +test('abstract_refinement_hole_fits', normal, compile, ['-fdefer-type-errors -fno-max-valid-hole-fits -fno-max-refinement-hole-fits -frefinement-level-hole-fits=2 -fabstract-refinement-hole-fits -funclutter-valid-hole-fits']) +test('free_monad_hole_fits', normal, compile, ['-fdefer-type-errors -fno-max-valid-hole-fits -fno-max-refinement-hole-fits -frefinement-level-hole-fits=2 -funclutter-valid-hole-fits']) +test('constraint_hole_fits', normal, compile, ['-fdefer-type-errors -fno-max-valid-hole-fits -fno-max-refinement-hole-fits -frefinement-level-hole-fits=2 -funclutter-valid-hole-fits']) +test('type_in_type_hole_fits', normal, compile, ['-fdefer-type-errors -fno-max-valid-hole-fits']) +test('T15370', normal, compile, ['-fdefer-type-errors -fno-max-valid-hole-fits -funclutter-valid-hole-fits']) test('T7408', normal, compile, ['']) test('UnboxStrictPrimitiveFields', normal, compile, ['']) test('T7541', normal, compile, ['']) @@ -496,6 +505,7 @@ test('T11401', normal, compile, ['']) test('T11699', normal, compile, ['']) test('T11512', normal, compile, ['']) test('T11754', normal, compile, ['']) +test('T11766', normal, compile, ['']) test('T11811', normal, compile, ['']) test('T11793', normal, compile, ['']) test('T11348', normal, compile, ['']) @@ -533,9 +543,9 @@ test('T12797', normal, compile, ['']) test('T12850', normal, compile, ['']) test('T12911', normal, compile, ['']) test('T12925', normal, compile, ['']) -test('T12919', expect_broken(12919), compile, ['']) +test('T12919', normal, compile, ['']) test('T12936', normal, compile, ['']) -test('T13050', normal, compile, ['-fdefer-type-errors']) +test('T13050', normal, compile, ['-fdefer-type-errors -fno-max-valid-hole-fits']) test('T13083', normal, compile, ['']) test('T11723', normal, compile, ['']) test('T12987', normal, compile, ['']) @@ -556,18 +566,88 @@ test('T13474', normal, compile, ['']) test('T13524', normal, compile, ['']) test('T13509', normal, compile, ['']) test('T13526', normal, compile, ['']) -test('T13594', normal, compile, ['']) +test('T13594', normal, compile_fail, ['']) test('T13603', normal, compile, ['']) test('T13333', normal, compile, ['']) test('T13585', [extra_files(['T13585.hs', 'T13585a.hs', 'T13585b.hs'])], run_command, ['$MAKE -s --no-print-directory T13585']) -test('T13651', normal, compile, ['']) +test('T13651', normal, compile_fail, ['']) +test('T13651a', normal, compile, ['']) test('T13680', normal, compile, ['']) test('T13785', normal, compile, ['']) test('T13804', normal, compile, ['']) test('T13822', normal, compile, ['']) +test('T13848', normal, compile, ['']) test('T13871', normal, compile, ['']) test('T13879', normal, compile, ['']) test('T13881', normal, compile, ['']) -test('T13915a', normal, multimod_compile, ['T13915a', '-v0']) -test('T13915b', normal, compile, ['']) +test('T13915a', expect_broken(15245), multimod_compile, ['T13915a', '-v0']) +test('T13915b', expect_broken(15245), compile, ['']) test('T13984', normal, compile, ['']) +test('T14128', normal, multimod_compile, ['T14128Main', '-v0']) +test('T14149', normal, compile_fail, ['']) +test('T14154', normal, compile, ['']) +test('T14158', normal, compile, ['']) +test('T13943', normal, compile, ['-fsolve-constant-dicts']) +test('T14333', normal, compile, ['']) +test('T14363', normal, compile, ['']) +test('T14363a', normal, compile, ['']) +test('T7169', normal, compile, ['']) +test('T14396', [extra_files(['T14396.hs', 'T14396.hs-boot', 'T14396a.hs', 'T14396b.hs', 'T14396f.hs'])], multimod_compile, ['T14396', '-v0']) +test('T14434', [], run_command, ['$MAKE -s --no-print-directory T14434']) +test('MissingExportList01', normal, compile, ['']) +test('MissingExportList02', normal, compile, ['']) +test('T14488', normal, compile, ['']) +test('T14590', normal, compile, ['-fdefer-type-errors -fno-max-valid-hole-fits']) +# We omit the hpc/profasm ways because this test checks the +# desugarer's output and these ways add some +# annotations/ticks that prevent it from giving the exact +# output we expect (T13032.stderr). +test('T13032', omit_ways(['hpc', 'profasm']), compile, ['']) +test('T14273', normal, compile, ['-fdefer-type-errors -fno-max-valid-hole-fits']) +test('T14732', normal, compile, ['']) +test('T14774', [], run_command, ['$MAKE -s --no-print-directory T14774']) +test('T14763', normal, compile, ['']) +test('T14811', normal, compile, ['']) +test('T14934', [extra_files(['T14934.hs', 'T14934a.hs'])], run_command, + ['$MAKE -s --no-print-directory T14934']) +test('T13643', normal, compile, ['']) +test('SplitWD', normal, compile, ['']) +# we omit profasm because it fails with: +# T14441.hs:1:1: fatal: +# Cannot load -prof objects when GHC is built with -dynamic +# To fix this, either: +# (1) Use -fexternal-interpreter, or +# (2) Build the program twice: once with -dynamic, and then +# with -prof using -osuf to set a different object file suffix. +test('T14441', omit_ways(['profasm']), compile, ['']) +test('T15050', normal, compile, ['']) +test('T14735', normal, compile, ['']) +test('T15180', normal, compile, ['']) +test('T15232', normal, compile, ['']) +test('T13833', normal, compile, ['']) +test('T14185', expect_broken(14185), compile, ['']) + +def onlyHsParLocs(x): + """ + We only want to check that all the parentheses are present with the correct location, + not compare the entire typechecked AST. + Located (HsPar GhcTc) are pretty printed with the form + ({ <location info> + (HsPar + This function tries to extract all such location infos from the typechecked AST. + """ + ls = x.split("\n") + filteredLines = (loc.strip() for (loc,hspar) in zip(ls,ls[1:]) + if hspar.strip().startswith("(HsPar") + and not "<no location info>" in loc) + return '\n'.join(filteredLines) +test('T15242', normalise_errmsg_fun(onlyHsParLocs), compile, ['']) +test('T15431', normal, compile, ['']) +test('T15431a', normal, compile, ['']) +test('T15428', normal, compile, ['']) +test('T15412', normal, compile, ['']) +test('T15141', normal, compile, ['']) +test('T15473', normal, compile_fail, ['']) +test('T15499', normal, compile, ['']) +test('T15586', normal, compile, ['']) +test('T15368', normal, compile, ['-fdefer-type-errors']) diff --git a/testsuite/tests/typecheck/should_compile/constraint_hole_fits.hs b/testsuite/tests/typecheck/should_compile/constraint_hole_fits.hs new file mode 100644 index 0000000000..0cc46f4075 --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/constraint_hole_fits.hs @@ -0,0 +1,4 @@ +module ConstraintSubstitutions where + +g :: Ord a => [a] -> a +g = _ diff --git a/testsuite/tests/typecheck/should_compile/constraint_hole_fits.stderr b/testsuite/tests/typecheck/should_compile/constraint_hole_fits.stderr new file mode 100644 index 0000000000..7e23fe8b86 --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/constraint_hole_fits.stderr @@ -0,0 +1,57 @@ + +constraint_hole_fits.hs:4:5: warning: [-Wtyped-holes (in -Wdefault)] + • Found hole: _ :: [a] -> a + Where: ‘a’ is a rigid type variable bound by + the type signature for: + g :: forall a. Ord a => [a] -> a + at constraint_hole_fits.hs:3:1-22 + • In the expression: _ + In an equation for ‘g’: g = _ + • Relevant bindings include + g :: [a] -> a (bound at constraint_hole_fits.hs:4:1) + Constraints include Ord a (from constraint_hole_fits.hs:3:1-22) + Valid hole fits include + g :: [a] -> a + head :: forall a. [a] -> a + last :: forall a. [a] -> a + maximum :: forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a + minimum :: forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a + Valid refinement hole fits include + foldl1 (_ :: a -> a -> a) + where foldl1 :: forall (t :: * -> *) a. + Foldable t => + (a -> a -> a) -> t a -> a + foldr1 (_ :: a -> a -> a) + where foldr1 :: forall (t :: * -> *) a. + Foldable t => + (a -> a -> a) -> t a -> a + foldl (_ :: a -> a -> a) (_ :: a) + where foldl :: forall (t :: * -> *) b a. + Foldable t => + (b -> a -> b) -> b -> t a -> b + foldr (_ :: a -> a -> a) (_ :: a) + where foldr :: forall (t :: * -> *) a b. + Foldable t => + (a -> b -> b) -> b -> t a -> b + const (_ :: a) + where const :: forall a b. a -> b -> a + ($) (_ :: [a] -> a) + where ($) :: forall a b. (a -> b) -> a -> b + fail (_ :: String) + where fail :: forall (m :: * -> *) a. Monad m => String -> m a + return (_ :: a) + where return :: forall (m :: * -> *) a. Monad m => a -> m a + pure (_ :: a) + where pure :: forall (f :: * -> *) a. Applicative f => a -> f a + ($!) (_ :: [a] -> a) + where ($!) :: forall a b. (a -> b) -> a -> b + id (_ :: [a] -> a) + where id :: forall a. a -> a + head (_ :: [[a] -> a]) + where head :: forall a. [a] -> a + last (_ :: [[a] -> a]) + where last :: forall a. [a] -> a + asTypeOf (_ :: [a] -> a) (_ :: [a] -> a) + where asTypeOf :: forall a. a -> a -> a + (!!) (_ :: [[a] -> a]) (_ :: Int) + where (!!) :: forall a. [a] -> Int -> a diff --git a/testsuite/tests/typecheck/should_compile/free_monad_hole_fits.hs b/testsuite/tests/typecheck/should_compile/free_monad_hole_fits.hs new file mode 100644 index 0000000000..0fa5b77128 --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/free_monad_hole_fits.hs @@ -0,0 +1,25 @@ +{-# OPTIONS_GHC -frefinement-level-hole-fits=2 #-} +{-# LANGUAGE MonoLocalBinds #-} +module TG where +import Prelude ( Monad, Applicative, Functor + , fmap, (<*>), pure, (>>=) + , (=<<), ($), (<$>) ) + +data Free f a = Pure a | Free (f (Free f a)) + +instance Functor f => Functor (Free f) where + fmap f = go where + go (Pure a) = Pure (f a) + -- Should suggest (fmap) + go (Free fa) = Free (_a go fa) + +instance Functor f => Applicative (Free f) where + pure = Pure + Pure a <*> Pure b = Pure (a b) + Pure a <*> Free mb = Free (fmap a <$> mb) + Free ma <*> b = Free ((<*> b) <$> ma) + +instance Applicative f => Monad (Free f) where + Pure a >>= f = f a + -- Should suggest ((=<< (_ :: a -> Free f b)) + Free f >>= g = Free (fmap _a f) diff --git a/testsuite/tests/typecheck/should_compile/free_monad_hole_fits.stderr b/testsuite/tests/typecheck/should_compile/free_monad_hole_fits.stderr new file mode 100644 index 0000000000..851e92e5fd --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/free_monad_hole_fits.stderr @@ -0,0 +1,77 @@ + +free_monad_hole_fits.hs:14:28: warning: [-Wtyped-holes (in -Wdefault)] + • Found hole: + _a :: (Free f a -> Free f b) -> f (Free f a) -> f (Free f b) + Where: ‘a’, ‘b’ are rigid type variables bound by + the type signature for: + fmap :: forall a b. (a -> b) -> Free f a -> Free f b + at free_monad_hole_fits.hs:11:5-8 + ‘f’ is a rigid type variable bound by + the instance declaration + at free_monad_hole_fits.hs:10:10-38 + Or perhaps ‘_a’ is mis-spelled, or not in scope + • In the expression: _a + In the first argument of ‘Free’, namely ‘(_a go fa)’ + In the expression: Free (_a go fa) + • Relevant bindings include + fa :: f (Free f a) (bound at free_monad_hole_fits.hs:14:16) + go :: Free f a -> Free f b (bound at free_monad_hole_fits.hs:12:7) + f :: a -> b (bound at free_monad_hole_fits.hs:11:10) + fmap :: (a -> b) -> Free f a -> Free f b + (bound at free_monad_hole_fits.hs:11:5) + Constraints include + Functor f (from free_monad_hole_fits.hs:10:10-38) + Valid hole fits include + fmap :: forall (f :: * -> *) a b. + Functor f => + (a -> b) -> f a -> f b + (<$>) :: forall (f :: * -> *) a b. + Functor f => + (a -> b) -> f a -> f b + Valid refinement hole fits include + ($) (_ :: (Free f a -> Free f b) -> f (Free f a) -> f (Free f b)) + where ($) :: forall a b. (a -> b) -> a -> b + pure (_ :: f (Free f a) -> f (Free f b)) + where pure :: forall (f :: * -> *) a. Applicative f => a -> f a + +free_monad_hole_fits.hs:25:31: warning: [-Wtyped-holes (in -Wdefault)] + • Found hole: _a :: Free f a -> Free f b + Where: ‘a’, ‘b’ are rigid type variables bound by + the type signature for: + (>>=) :: forall a b. Free f a -> (a -> Free f b) -> Free f b + at free_monad_hole_fits.hs:23:12-14 + ‘f’ is a rigid type variable bound by + the instance declaration + at free_monad_hole_fits.hs:22:10-40 + Or perhaps ‘_a’ is mis-spelled, or not in scope + • In the first argument of ‘fmap’, namely ‘_a’ + In the first argument of ‘Free’, namely ‘(fmap _a f)’ + In the expression: Free (fmap _a f) + • Relevant bindings include + g :: a -> Free f b (bound at free_monad_hole_fits.hs:25:16) + f :: f (Free f a) (bound at free_monad_hole_fits.hs:25:10) + (>>=) :: Free f a -> (a -> Free f b) -> Free f b + (bound at free_monad_hole_fits.hs:23:12) + Constraints include + Applicative f (from free_monad_hole_fits.hs:22:10-40) + Valid refinement hole fits include + fmap (_ :: a -> b) + where fmap :: forall (f :: * -> *) a b. + Functor f => + (a -> b) -> f a -> f b + (<*>) (_ :: Free f (a -> b)) + where (<*>) :: forall (f :: * -> *) a b. + Applicative f => + f (a -> b) -> f a -> f b + (<$>) (_ :: a -> b) + where (<$>) :: forall (f :: * -> *) a b. + Functor f => + (a -> b) -> f a -> f b + (=<<) (_ :: a -> Free f b) + where (=<<) :: forall (m :: * -> *) a b. + Monad m => + (a -> m b) -> m a -> m b + ($) (_ :: Free f a -> Free f b) + where ($) :: forall a b. (a -> b) -> a -> b + pure (_ :: Free f b) + where pure :: forall (f :: * -> *) a. Applicative f => a -> f a diff --git a/testsuite/tests/typecheck/should_compile/hole_constraints.stderr b/testsuite/tests/typecheck/should_compile/hole_constraints.stderr index b464547365..82cc6262bd 100644 --- a/testsuite/tests/typecheck/should_compile/hole_constraints.stderr +++ b/testsuite/tests/typecheck/should_compile/hole_constraints.stderr @@ -10,6 +10,7 @@ hole_constraints.hs:8:6: warning: [-Wtyped-holes (in -Wdefault)] • Relevant bindings include f1 :: a (bound at hole_constraints.hs:8:1) Constraints include Eq a (from hole_constraints.hs:7:1-15) + Valid hole fits include f1 :: a hole_constraints.hs:12:6: warning: [-Wtyped-holes (in -Wdefault)] • Found hole: _ :: a @@ -24,17 +25,25 @@ hole_constraints.hs:12:6: warning: [-Wtyped-holes (in -Wdefault)] Constraints include Show a (from hole_constraints.hs:11:1-25) Eq a (from hole_constraints.hs:11:1-25) + Valid hole fits include + f2 :: a + f1 :: forall a. Eq a => a hole_constraints.hs:16:35: warning: [-Wtyped-holes (in -Wdefault)] • Found hole: _ :: [a] Where: ‘a’ is a rigid type variable bound by - the instance declaration at hole_constraints.hs:16:10-22 + the instance declaration + at hole_constraints.hs:16:10-22 • In the expression: _ In an equation for ‘f3’: f3 = _ In the instance declaration for ‘C [a]’ • Relevant bindings include f3 :: [a] (bound at hole_constraints.hs:16:30) Constraints include Eq a (from hole_constraints.hs:16:10-22) + Valid hole fits include + f3 :: [a] + f1 :: forall a. Eq a => a + mempty :: forall a. Monoid a => a hole_constraints.hs:20:19: warning: [-Wtyped-holes (in -Wdefault)] • Found hole: _ :: a @@ -48,6 +57,7 @@ hole_constraints.hs:20:19: warning: [-Wtyped-holes (in -Wdefault)] x :: a (bound at hole_constraints.hs:20:15) castWith :: (a :~: b) -> a -> b (bound at hole_constraints.hs:20:1) Constraints include b ~ a (from hole_constraints.hs:20:10-13) + Valid hole fits include x :: a hole_constraints.hs:27:32: warning: [-Wtyped-holes (in -Wdefault)] • Found hole: _ :: String @@ -59,3 +69,8 @@ hole_constraints.hs:27:32: warning: [-Wtyped-holes (in -Wdefault)] a :: AnyShow (bound at hole_constraints.hs:27:5) foo :: AnyShow -> String (bound at hole_constraints.hs:27:1) Constraints include Show a (from hole_constraints.hs:27:19-27) + Valid hole fits include + f3 :: forall a. C a => a + f1 :: forall a. Eq a => a + f2 :: forall a. (Show a, Eq a) => a + mempty :: forall a. Monoid a => a diff --git a/testsuite/tests/typecheck/should_compile/hole_constraints_nested.stderr b/testsuite/tests/typecheck/should_compile/hole_constraints_nested.stderr index b41aec8946..46c0c22a34 100644 --- a/testsuite/tests/typecheck/should_compile/hole_constraints_nested.stderr +++ b/testsuite/tests/typecheck/should_compile/hole_constraints_nested.stderr @@ -13,3 +13,6 @@ hole_constraints_nested.hs:12:16: warning: [-Wtyped-holes (in -Wdefault)] Eq a (from hole_constraints_nested.hs:12:7-11) Ord a (from hole_constraints_nested.hs:12:7-11) b ~ a (from hole_constraints_nested.hs:11:5-8) + Valid hole fits include + maxBound :: forall a. Bounded a => a + minBound :: forall a. Bounded a => a diff --git a/testsuite/tests/typecheck/should_compile/holes.stderr b/testsuite/tests/typecheck/should_compile/holes.stderr index aadc844290..429961c261 100644 --- a/testsuite/tests/typecheck/should_compile/holes.stderr +++ b/testsuite/tests/typecheck/should_compile/holes.stderr @@ -2,10 +2,12 @@ holes.hs:3:5: warning: [-Wtyped-holes (in -Wdefault)] • Found hole: _ :: t Where: ‘t’ is a rigid type variable bound by - the inferred type of f :: t at holes.hs:3:1-5 + the inferred type of f :: t + at holes.hs:3:1-5 • In the expression: _ In an equation for ‘f’: f = _ • Relevant bindings include f :: t (bound at holes.hs:3:1) + Valid hole fits include f :: forall t. t holes.hs:6:7: warning: [-Wtyped-holes (in -Wdefault)] • Found hole: _ :: Char @@ -14,6 +16,10 @@ holes.hs:6:7: warning: [-Wtyped-holes (in -Wdefault)] • Relevant bindings include x :: Int (bound at holes.hs:6:3) g :: Int -> Char (bound at holes.hs:6:1) + Valid hole fits include + f :: forall t. t + maxBound :: forall a. Bounded a => a + minBound :: forall a. Bounded a => a holes.hs:8:5: warning: [-Wtyped-holes (in -Wdefault)] • Found hole: _ :: [Char] @@ -21,6 +27,10 @@ holes.hs:8:5: warning: [-Wtyped-holes (in -Wdefault)] In the expression: _ ++ "a" In an equation for ‘h’: h = _ ++ "a" • Relevant bindings include h :: [Char] (bound at holes.hs:8:1) + Valid hole fits include + h :: [Char] + f :: forall t. t + mempty :: forall a. Monoid a => a holes.hs:11:15: warning: [-Wtyped-holes (in -Wdefault)] • Found hole: _ :: b0 @@ -31,3 +41,155 @@ holes.hs:11:15: warning: [-Wtyped-holes (in -Wdefault)] • Relevant bindings include y :: [a] (bound at holes.hs:11:3) z :: [a] -> [a] (bound at holes.hs:11:1) + Valid hole fits include + y :: [a] + z :: [a] -> [a] + g :: Int -> Char + h :: [Char] + f :: forall t. t + otherwise :: Bool + False :: Bool + True :: Bool + lines :: String -> [String] + unlines :: [String] -> String + unwords :: [String] -> String + words :: String -> [String] + userError :: String -> IOError + lex :: ReadS String + showChar :: Char -> ShowS + showParen :: Bool -> ShowS -> ShowS + showString :: String -> ShowS + appendFile :: FilePath -> String -> IO () + getChar :: IO Char + getContents :: IO String + getLine :: IO String + interact :: (String -> String) -> IO () + putChar :: Char -> IO () + putStr :: String -> IO () + putStrLn :: String -> IO () + readFile :: FilePath -> IO String + writeFile :: FilePath -> String -> IO () + (&&) :: Bool -> Bool -> Bool + not :: Bool -> Bool + (||) :: Bool -> Bool -> Bool + EQ :: Ordering + LT :: Ordering + GT :: Ordering + (++) :: forall a. [a] -> [a] -> [a] + filter :: forall a. (a -> Bool) -> [a] -> [a] + fromInteger :: forall a. Num a => Integer -> a + (-) :: forall a. Num a => a -> a -> a + fromRational :: forall a. Fractional a => Rational -> a + negate :: forall a. Num a => a -> a + fromIntegral :: forall a b. (Integral a, Num b) => a -> b + toInteger :: forall a. Integral a => a -> Integer + toRational :: forall a. Real a => a -> Rational + Nothing :: forall a. Maybe a + Just :: forall a. a -> Maybe a + asTypeOf :: forall a. a -> a -> a + id :: forall a. a -> a + until :: forall a. (a -> Bool) -> (a -> a) -> a -> a + ioError :: forall a. IOError -> IO a + (!!) :: forall a. [a] -> Int -> a + break :: forall a. (a -> Bool) -> [a] -> ([a], [a]) + cycle :: forall a. [a] -> [a] + drop :: forall a. Int -> [a] -> [a] + dropWhile :: forall a. (a -> Bool) -> [a] -> [a] + head :: forall a. [a] -> a + init :: forall a. [a] -> [a] + iterate :: forall a. (a -> a) -> a -> [a] + last :: forall a. [a] -> a + repeat :: forall a. a -> [a] + replicate :: forall a. Int -> a -> [a] + reverse :: forall a. [a] -> [a] + scanl1 :: forall a. (a -> a -> a) -> [a] -> [a] + scanr1 :: forall a. (a -> a -> a) -> [a] -> [a] + span :: forall a. (a -> Bool) -> [a] -> ([a], [a]) + splitAt :: forall a. Int -> [a] -> ([a], [a]) + tail :: forall a. [a] -> [a] + take :: forall a. Int -> [a] -> [a] + takeWhile :: forall a. (a -> Bool) -> [a] -> [a] + subtract :: forall a. Num a => a -> a -> a + readParen :: forall a. Bool -> ReadS a -> ReadS a + (^) :: forall a b. (Num a, Integral b) => a -> b -> a + even :: forall a. Integral a => a -> Bool + gcd :: forall a. Integral a => a -> a -> a + lcm :: forall a. Integral a => a -> a -> a + odd :: forall a. Integral a => a -> Bool + (**) :: forall a. Floating a => a -> a -> a + acos :: forall a. Floating a => a -> a + acosh :: forall a. Floating a => a -> a + asin :: forall a. Floating a => a -> a + asinh :: forall a. Floating a => a -> a + atan :: forall a. Floating a => a -> a + atanh :: forall a. Floating a => a -> a + cos :: forall a. Floating a => a -> a + cosh :: forall a. Floating a => a -> a + exp :: forall a. Floating a => a -> a + log :: forall a. Floating a => a -> a + logBase :: forall a. Floating a => a -> a -> a + pi :: forall a. Floating a => a + sin :: forall a. Floating a => a -> a + sinh :: forall a. Floating a => a -> a + sqrt :: forall a. Floating a => a -> a + tan :: forall a. Floating a => a -> a + tanh :: forall a. Floating a => a -> a + atan2 :: forall a. RealFloat a => a -> a -> a + decodeFloat :: forall a. RealFloat a => a -> (Integer, Int) + encodeFloat :: forall a. RealFloat a => Integer -> Int -> a + exponent :: forall a. RealFloat a => a -> Int + floatDigits :: forall a. RealFloat a => a -> Int + floatRadix :: forall a. RealFloat a => a -> Integer + floatRange :: forall a. RealFloat a => a -> (Int, Int) + isDenormalized :: forall a. RealFloat a => a -> Bool + isIEEE :: forall a. RealFloat a => a -> Bool + isInfinite :: forall a. RealFloat a => a -> Bool + isNaN :: forall a. RealFloat a => a -> Bool + isNegativeZero :: forall a. RealFloat a => a -> Bool + scaleFloat :: forall a. RealFloat a => Int -> a -> a + significand :: forall a. RealFloat a => a -> a + (*) :: forall a. Num a => a -> a -> a + (+) :: forall a. Num a => a -> a -> a + abs :: forall a. Num a => a -> a + signum :: forall a. Num a => a -> a + (/) :: forall a. Fractional a => a -> a -> a + recip :: forall a. Fractional a => a -> a + div :: forall a. Integral a => a -> a -> a + divMod :: forall a. Integral a => a -> a -> (a, a) + mod :: forall a. Integral a => a -> a -> a + quot :: forall a. Integral a => a -> a -> a + quotRem :: forall a. Integral a => a -> a -> (a, a) + rem :: forall a. Integral a => a -> a -> a + seq :: forall a b. a -> b -> b + zip :: forall a b. [a] -> [b] -> [(a, b)] + fst :: forall a b. (a, b) -> a + snd :: forall a b. (a, b) -> b + map :: forall a b. (a -> b) -> [a] -> [b] + realToFrac :: forall a b. (Real a, Fractional b) => a -> b + maybe :: forall b a. b -> (a -> b) -> Maybe a -> b + const :: forall a b. a -> b -> a + scanl :: forall b a. (b -> a -> b) -> b -> [a] -> [b] + scanr :: forall a b. (a -> b -> b) -> b -> [a] -> [b] + unzip :: forall a b. [(a, b)] -> ([a], [b]) + (^^) :: forall a b. (Fractional a, Integral b) => a -> b -> a + ceiling :: forall a b. (RealFrac a, Integral b) => a -> b + floor :: forall a b. (RealFrac a, Integral b) => a -> b + properFraction :: forall a b. + (RealFrac a, Integral b) => + a -> (b, a) + round :: forall a b. (RealFrac a, Integral b) => a -> b + truncate :: forall a b. (RealFrac a, Integral b) => a -> b + Right :: forall a b. b -> Either a b + Left :: forall a b. a -> Either a b + ($) :: forall a b. (a -> b) -> a -> b + either :: forall a c b. (a -> c) -> (b -> c) -> Either a b -> c + curry :: forall a b c. ((a, b) -> c) -> a -> b -> c + uncurry :: forall a b c. (a -> b -> c) -> (a, b) -> c + ($!) :: forall a b. (a -> b) -> a -> b + (.) :: forall b c a. (b -> c) -> (a -> b) -> a -> c + flip :: forall a b c. (a -> b -> c) -> b -> a -> c + unzip3 :: forall a b c. [(a, b, c)] -> ([a], [b], [c]) + zip3 :: forall a b c. [a] -> [b] -> [c] -> [(a, b, c)] + zipWith :: forall a b c. (a -> b -> c) -> [a] -> [b] -> [c] + zipWith3 :: forall a b c d. + (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d] diff --git a/testsuite/tests/typecheck/should_compile/holes2.stderr b/testsuite/tests/typecheck/should_compile/holes2.stderr index eb8d56f1e3..4ed5dfc552 100644 --- a/testsuite/tests/typecheck/should_compile/holes2.stderr +++ b/testsuite/tests/typecheck/should_compile/holes2.stderr @@ -4,11 +4,12 @@ holes2.hs:3:5: warning: [-Wdeferred-type-errors (in -Wdefault)] prevents the constraint ‘(Show a0)’ from being solved. Probable fix: use a type annotation to specify what ‘a0’ should be. These potential instances exist: + instance (Show a, Show b) => Show (Either a b) + -- Defined in ‘Data.Either’ instance Show Ordering -- Defined in ‘GHC.Show’ instance Show Integer -- Defined in ‘GHC.Show’ - instance Show a => Show (Maybe a) -- Defined in ‘GHC.Show’ - ...plus 22 others - ...plus five instances involving out-of-scope types + ...plus 23 others + ...plus 70 instances involving out-of-scope types (use -fprint-potential-instances to see them all) • In the expression: show _ In an equation for ‘f’: f = show _ @@ -20,3 +21,12 @@ holes2.hs:3:10: warning: [-Wtyped-holes (in -Wdefault)] In the expression: show _ In an equation for ‘f’: f = show _ • Relevant bindings include f :: String (bound at holes2.hs:3:1) + Valid hole fits include + f :: String + otherwise :: Bool + False :: Bool + True :: Bool + EQ :: Ordering + LT :: Ordering + GT :: Ordering + pi :: forall a. Floating a => a diff --git a/testsuite/tests/typecheck/should_compile/holes3.stderr b/testsuite/tests/typecheck/should_compile/holes3.stderr index 3a3fd572e1..8d7f4a7a86 100644 --- a/testsuite/tests/typecheck/should_compile/holes3.stderr +++ b/testsuite/tests/typecheck/should_compile/holes3.stderr @@ -2,10 +2,12 @@ holes3.hs:3:5: error: • Found hole: _ :: t Where: ‘t’ is a rigid type variable bound by - the inferred type of f :: t at holes3.hs:3:1-5 + the inferred type of f :: t + at holes3.hs:3:1-5 • In the expression: _ In an equation for ‘f’: f = _ • Relevant bindings include f :: t (bound at holes3.hs:3:1) + Valid hole fits include f :: forall t. t holes3.hs:6:7: error: • Found hole: _gr :: Char @@ -15,6 +17,10 @@ holes3.hs:6:7: error: • Relevant bindings include x :: Int (bound at holes3.hs:6:3) g :: Int -> Char (bound at holes3.hs:6:1) + Valid hole fits include + f :: forall t. t + maxBound :: forall a. Bounded a => a + minBound :: forall a. Bounded a => a holes3.hs:8:5: error: • Found hole: _aa :: [Char] @@ -23,6 +29,10 @@ holes3.hs:8:5: error: In the expression: _aa ++ "a" In an equation for ‘h’: h = _aa ++ "a" • Relevant bindings include h :: [Char] (bound at holes3.hs:8:1) + Valid hole fits include + h :: [Char] + f :: forall t. t + mempty :: forall a. Monoid a => a holes3.hs:11:15: error: • Found hole: _x :: b0 @@ -34,3 +44,155 @@ holes3.hs:11:15: error: • Relevant bindings include y :: [a] (bound at holes3.hs:11:3) z :: [a] -> [a] (bound at holes3.hs:11:1) + Valid hole fits include + y :: [a] + z :: [a] -> [a] + g :: Int -> Char + h :: [Char] + f :: forall t. t + otherwise :: Bool + False :: Bool + True :: Bool + lines :: String -> [String] + unlines :: [String] -> String + unwords :: [String] -> String + words :: String -> [String] + userError :: String -> IOError + lex :: ReadS String + showChar :: Char -> ShowS + showParen :: Bool -> ShowS -> ShowS + showString :: String -> ShowS + appendFile :: FilePath -> String -> IO () + getChar :: IO Char + getContents :: IO String + getLine :: IO String + interact :: (String -> String) -> IO () + putChar :: Char -> IO () + putStr :: String -> IO () + putStrLn :: String -> IO () + readFile :: FilePath -> IO String + writeFile :: FilePath -> String -> IO () + (&&) :: Bool -> Bool -> Bool + not :: Bool -> Bool + (||) :: Bool -> Bool -> Bool + EQ :: Ordering + LT :: Ordering + GT :: Ordering + (++) :: forall a. [a] -> [a] -> [a] + filter :: forall a. (a -> Bool) -> [a] -> [a] + fromInteger :: forall a. Num a => Integer -> a + (-) :: forall a. Num a => a -> a -> a + fromRational :: forall a. Fractional a => Rational -> a + negate :: forall a. Num a => a -> a + fromIntegral :: forall a b. (Integral a, Num b) => a -> b + toInteger :: forall a. Integral a => a -> Integer + toRational :: forall a. Real a => a -> Rational + Nothing :: forall a. Maybe a + Just :: forall a. a -> Maybe a + asTypeOf :: forall a. a -> a -> a + id :: forall a. a -> a + until :: forall a. (a -> Bool) -> (a -> a) -> a -> a + ioError :: forall a. IOError -> IO a + (!!) :: forall a. [a] -> Int -> a + break :: forall a. (a -> Bool) -> [a] -> ([a], [a]) + cycle :: forall a. [a] -> [a] + drop :: forall a. Int -> [a] -> [a] + dropWhile :: forall a. (a -> Bool) -> [a] -> [a] + head :: forall a. [a] -> a + init :: forall a. [a] -> [a] + iterate :: forall a. (a -> a) -> a -> [a] + last :: forall a. [a] -> a + repeat :: forall a. a -> [a] + replicate :: forall a. Int -> a -> [a] + reverse :: forall a. [a] -> [a] + scanl1 :: forall a. (a -> a -> a) -> [a] -> [a] + scanr1 :: forall a. (a -> a -> a) -> [a] -> [a] + span :: forall a. (a -> Bool) -> [a] -> ([a], [a]) + splitAt :: forall a. Int -> [a] -> ([a], [a]) + tail :: forall a. [a] -> [a] + take :: forall a. Int -> [a] -> [a] + takeWhile :: forall a. (a -> Bool) -> [a] -> [a] + subtract :: forall a. Num a => a -> a -> a + readParen :: forall a. Bool -> ReadS a -> ReadS a + (^) :: forall a b. (Num a, Integral b) => a -> b -> a + even :: forall a. Integral a => a -> Bool + gcd :: forall a. Integral a => a -> a -> a + lcm :: forall a. Integral a => a -> a -> a + odd :: forall a. Integral a => a -> Bool + (**) :: forall a. Floating a => a -> a -> a + acos :: forall a. Floating a => a -> a + acosh :: forall a. Floating a => a -> a + asin :: forall a. Floating a => a -> a + asinh :: forall a. Floating a => a -> a + atan :: forall a. Floating a => a -> a + atanh :: forall a. Floating a => a -> a + cos :: forall a. Floating a => a -> a + cosh :: forall a. Floating a => a -> a + exp :: forall a. Floating a => a -> a + log :: forall a. Floating a => a -> a + logBase :: forall a. Floating a => a -> a -> a + pi :: forall a. Floating a => a + sin :: forall a. Floating a => a -> a + sinh :: forall a. Floating a => a -> a + sqrt :: forall a. Floating a => a -> a + tan :: forall a. Floating a => a -> a + tanh :: forall a. Floating a => a -> a + atan2 :: forall a. RealFloat a => a -> a -> a + decodeFloat :: forall a. RealFloat a => a -> (Integer, Int) + encodeFloat :: forall a. RealFloat a => Integer -> Int -> a + exponent :: forall a. RealFloat a => a -> Int + floatDigits :: forall a. RealFloat a => a -> Int + floatRadix :: forall a. RealFloat a => a -> Integer + floatRange :: forall a. RealFloat a => a -> (Int, Int) + isDenormalized :: forall a. RealFloat a => a -> Bool + isIEEE :: forall a. RealFloat a => a -> Bool + isInfinite :: forall a. RealFloat a => a -> Bool + isNaN :: forall a. RealFloat a => a -> Bool + isNegativeZero :: forall a. RealFloat a => a -> Bool + scaleFloat :: forall a. RealFloat a => Int -> a -> a + significand :: forall a. RealFloat a => a -> a + (*) :: forall a. Num a => a -> a -> a + (+) :: forall a. Num a => a -> a -> a + abs :: forall a. Num a => a -> a + signum :: forall a. Num a => a -> a + (/) :: forall a. Fractional a => a -> a -> a + recip :: forall a. Fractional a => a -> a + div :: forall a. Integral a => a -> a -> a + divMod :: forall a. Integral a => a -> a -> (a, a) + mod :: forall a. Integral a => a -> a -> a + quot :: forall a. Integral a => a -> a -> a + quotRem :: forall a. Integral a => a -> a -> (a, a) + rem :: forall a. Integral a => a -> a -> a + seq :: forall a b. a -> b -> b + zip :: forall a b. [a] -> [b] -> [(a, b)] + fst :: forall a b. (a, b) -> a + snd :: forall a b. (a, b) -> b + map :: forall a b. (a -> b) -> [a] -> [b] + realToFrac :: forall a b. (Real a, Fractional b) => a -> b + maybe :: forall b a. b -> (a -> b) -> Maybe a -> b + const :: forall a b. a -> b -> a + scanl :: forall b a. (b -> a -> b) -> b -> [a] -> [b] + scanr :: forall a b. (a -> b -> b) -> b -> [a] -> [b] + unzip :: forall a b. [(a, b)] -> ([a], [b]) + (^^) :: forall a b. (Fractional a, Integral b) => a -> b -> a + ceiling :: forall a b. (RealFrac a, Integral b) => a -> b + floor :: forall a b. (RealFrac a, Integral b) => a -> b + properFraction :: forall a b. + (RealFrac a, Integral b) => + a -> (b, a) + round :: forall a b. (RealFrac a, Integral b) => a -> b + truncate :: forall a b. (RealFrac a, Integral b) => a -> b + Right :: forall a b. b -> Either a b + Left :: forall a b. a -> Either a b + ($) :: forall a b. (a -> b) -> a -> b + either :: forall a c b. (a -> c) -> (b -> c) -> Either a b -> c + curry :: forall a b c. ((a, b) -> c) -> a -> b -> c + uncurry :: forall a b c. (a -> b -> c) -> (a, b) -> c + ($!) :: forall a b. (a -> b) -> a -> b + (.) :: forall b c a. (b -> c) -> (a -> b) -> a -> c + flip :: forall a b c. (a -> b -> c) -> b -> a -> c + unzip3 :: forall a b c. [(a, b, c)] -> ([a], [b], [c]) + zip3 :: forall a b c. [a] -> [b] -> [c] -> [(a, b, c)] + zipWith :: forall a b c. (a -> b -> c) -> [a] -> [b] -> [c] + zipWith3 :: forall a b c d. + (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d] diff --git a/testsuite/tests/typecheck/should_compile/local_hole_fits.hs b/testsuite/tests/typecheck/should_compile/local_hole_fits.hs new file mode 100755 index 0000000000..8e257ffe61 --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/local_hole_fits.hs @@ -0,0 +1,11 @@ +import Prelude (Show, String, error, IO(), show, Ordering(EQ)) + +head :: [a] -> a +head (x:xs) = _ +head _ = error "Empty list!" + +mshow :: Show a => a -> a +mshow a = _ + +main :: IO () +main = error "no main" diff --git a/testsuite/tests/typecheck/should_compile/local_hole_fits.stderr b/testsuite/tests/typecheck/should_compile/local_hole_fits.stderr new file mode 100644 index 0000000000..5485d05bef --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/local_hole_fits.stderr @@ -0,0 +1,28 @@ + +local_hole_fits.hs:4:15: warning: [-Wtyped-holes (in -Wdefault)] + • Found hole: _ :: a + Where: ‘a’ is a rigid type variable bound by + the type signature for: + head :: forall a. [a] -> a + at local_hole_fits.hs:3:1-16 + • In the expression: _ + In an equation for ‘head’: head (x : xs) = _ + • Relevant bindings include + xs :: [a] (bound at local_hole_fits.hs:4:9) + x :: a (bound at local_hole_fits.hs:4:7) + head :: [a] -> a (bound at local_hole_fits.hs:4:1) + Valid hole fits include x :: a (bound at local_hole_fits.hs:4:7) + +local_hole_fits.hs:8:11: warning: [-Wtyped-holes (in -Wdefault)] + • Found hole: _ :: a + Where: ‘a’ is a rigid type variable bound by + the type signature for: + mshow :: forall a. Show a => a -> a + at local_hole_fits.hs:7:1-25 + • In the expression: _ + In an equation for ‘mshow’: mshow a = _ + • Relevant bindings include + a :: a (bound at local_hole_fits.hs:8:7) + mshow :: a -> a (bound at local_hole_fits.hs:8:1) + Constraints include Show a (from local_hole_fits.hs:7:1-25) + Valid hole fits include a :: a (bound at local_hole_fits.hs:8:7) diff --git a/testsuite/tests/typecheck/should_compile/refinement_hole_fits.hs b/testsuite/tests/typecheck/should_compile/refinement_hole_fits.hs new file mode 100644 index 0000000000..345a6c8f8e --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/refinement_hole_fits.hs @@ -0,0 +1,7 @@ +module RefinementSubstitutions where + +f :: [Integer] -> Integer +f = _ + +g :: [Integer] -> Integer +g = _ 0 diff --git a/testsuite/tests/typecheck/should_compile/refinement_hole_fits.stderr b/testsuite/tests/typecheck/should_compile/refinement_hole_fits.stderr new file mode 100644 index 0000000000..77c7ae6e79 --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/refinement_hole_fits.stderr @@ -0,0 +1,220 @@ + +refinement_hole_fits.hs:4:5: warning: [-Wtyped-holes (in -Wdefault)] + • Found hole: _ :: [Integer] -> Integer + • In the expression: _ + In an equation for ‘f’: f = _ + • Relevant bindings include + f :: [Integer] -> Integer (bound at refinement_hole_fits.hs:4:1) + Valid hole fits include + f :: [Integer] -> Integer (bound at refinement_hole_fits.hs:4:1) + g :: [Integer] -> Integer (bound at refinement_hole_fits.hs:7:1) + head :: forall a. [a] -> a + with head @Integer + (imported from ‘Prelude’ at refinement_hole_fits.hs:1:8-30 + (and originally defined in ‘GHC.List’)) + last :: forall a. [a] -> a + with last @Integer + (imported from ‘Prelude’ at refinement_hole_fits.hs:1:8-30 + (and originally defined in ‘GHC.List’)) + maximum :: forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a + with maximum @[] @Integer + (imported from ‘Prelude’ at refinement_hole_fits.hs:1:8-30 + (and originally defined in ‘Data.Foldable’)) + minimum :: forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a + with minimum @[] @Integer + (imported from ‘Prelude’ at refinement_hole_fits.hs:1:8-30 + (and originally defined in ‘Data.Foldable’)) + product :: forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a + with product @[] @Integer + (imported from ‘Prelude’ at refinement_hole_fits.hs:1:8-30 + (and originally defined in ‘Data.Foldable’)) + sum :: forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a + with sum @[] @Integer + (imported from ‘Prelude’ at refinement_hole_fits.hs:1:8-30 + (and originally defined in ‘Data.Foldable’)) + Valid refinement hole fits include + foldl1 (_ :: Integer -> Integer -> Integer) + where foldl1 :: forall (t :: * -> *) a. + Foldable t => + (a -> a -> a) -> t a -> a + with foldl1 @[] @Integer + (imported from ‘Prelude’ at refinement_hole_fits.hs:1:8-30 + (and originally defined in ‘Data.Foldable’)) + foldr1 (_ :: Integer -> Integer -> Integer) + where foldr1 :: forall (t :: * -> *) a. + Foldable t => + (a -> a -> a) -> t a -> a + with foldr1 @[] @Integer + (imported from ‘Prelude’ at refinement_hole_fits.hs:1:8-30 + (and originally defined in ‘Data.Foldable’)) + foldl (_ :: Integer -> Integer -> Integer) (_ :: Integer) + where foldl :: forall (t :: * -> *) b a. + Foldable t => + (b -> a -> b) -> b -> t a -> b + with foldl @[] @Integer @Integer + (imported from ‘Prelude’ at refinement_hole_fits.hs:1:8-30 + (and originally defined in ‘Data.Foldable’)) + foldr (_ :: Integer -> Integer -> Integer) (_ :: Integer) + where foldr :: forall (t :: * -> *) a b. + Foldable t => + (a -> b -> b) -> b -> t a -> b + with foldr @[] @Integer @Integer + (imported from ‘Prelude’ at refinement_hole_fits.hs:1:8-30 + (and originally defined in ‘Data.Foldable’)) + const (_ :: Integer) + where const :: forall a b. a -> b -> a + with const @Integer @[Integer] + (imported from ‘Prelude’ at refinement_hole_fits.hs:1:8-30 + (and originally defined in ‘GHC.Base’)) + ($) (_ :: [Integer] -> Integer) + where ($) :: forall a b. (a -> b) -> a -> b + with ($) @'GHC.Types.LiftedRep @[Integer] @Integer + (imported from ‘Prelude’ at refinement_hole_fits.hs:1:8-30 + (and originally defined in ‘GHC.Base’)) + fail (_ :: String) + where fail :: forall (m :: * -> *) a. Monad m => String -> m a + with fail @((->) [Integer]) @Integer + (imported from ‘Prelude’ at refinement_hole_fits.hs:1:8-30 + (and originally defined in ‘GHC.Base’)) + return (_ :: Integer) + where return :: forall (m :: * -> *) a. Monad m => a -> m a + with return @((->) [Integer]) @Integer + (imported from ‘Prelude’ at refinement_hole_fits.hs:1:8-30 + (and originally defined in ‘GHC.Base’)) + pure (_ :: Integer) + where pure :: forall (f :: * -> *) a. Applicative f => a -> f a + with pure @((->) [Integer]) @Integer + (imported from ‘Prelude’ at refinement_hole_fits.hs:1:8-30 + (and originally defined in ‘GHC.Base’)) + ($!) (_ :: [Integer] -> Integer) + where ($!) :: forall a b. (a -> b) -> a -> b + with ($!) @'GHC.Types.LiftedRep @[Integer] @Integer + (imported from ‘Prelude’ at refinement_hole_fits.hs:1:8-30 + (and originally defined in ‘GHC.Base’)) + id (_ :: [Integer] -> Integer) + where id :: forall a. a -> a + with id @([Integer] -> Integer) + (imported from ‘Prelude’ at refinement_hole_fits.hs:1:8-30 + (and originally defined in ‘GHC.Base’)) + head (_ :: [[Integer] -> Integer]) + where head :: forall a. [a] -> a + with head @([Integer] -> Integer) + (imported from ‘Prelude’ at refinement_hole_fits.hs:1:8-30 + (and originally defined in ‘GHC.List’)) + last (_ :: [[Integer] -> Integer]) + where last :: forall a. [a] -> a + with last @([Integer] -> Integer) + (imported from ‘Prelude’ at refinement_hole_fits.hs:1:8-30 + (and originally defined in ‘GHC.List’)) + asTypeOf (_ :: [Integer] -> Integer) (_ :: [Integer] -> Integer) + where asTypeOf :: forall a. a -> a -> a + with asTypeOf @([Integer] -> Integer) + (imported from ‘Prelude’ at refinement_hole_fits.hs:1:8-30 + (and originally defined in ‘GHC.Base’)) + (!!) (_ :: [[Integer] -> Integer]) (_ :: Int) + where (!!) :: forall a. [a] -> Int -> a + with (!!) @([Integer] -> Integer) + (imported from ‘Prelude’ at refinement_hole_fits.hs:1:8-30 + (and originally defined in ‘GHC.List’)) + +refinement_hole_fits.hs:7:5: warning: [-Wtyped-holes (in -Wdefault)] + • Found hole: _ :: Integer -> [Integer] -> Integer + • In the expression: _ + In the expression: _ 0 + In an equation for ‘g’: g = _ 0 + • Relevant bindings include + g :: [Integer] -> Integer (bound at refinement_hole_fits.hs:7:1) + Valid hole fits include + const :: forall a b. a -> b -> a + with const @Integer @[Integer] + (imported from ‘Prelude’ at refinement_hole_fits.hs:1:8-30 + (and originally defined in ‘GHC.Base’)) + return :: forall (m :: * -> *) a. Monad m => a -> m a + with return @((->) [Integer]) @Integer + (imported from ‘Prelude’ at refinement_hole_fits.hs:1:8-30 + (and originally defined in ‘GHC.Base’)) + pure :: forall (f :: * -> *) a. Applicative f => a -> f a + with pure @((->) [Integer]) @Integer + (imported from ‘Prelude’ at refinement_hole_fits.hs:1:8-30 + (and originally defined in ‘GHC.Base’)) + Valid refinement hole fits include + foldl (_ :: Integer -> Integer -> Integer) + where foldl :: forall (t :: * -> *) b a. + Foldable t => + (b -> a -> b) -> b -> t a -> b + with foldl @[] @Integer @Integer + (imported from ‘Prelude’ at refinement_hole_fits.hs:1:8-30 + (and originally defined in ‘Data.Foldable’)) + foldr (_ :: Integer -> Integer -> Integer) + where foldr :: forall (t :: * -> *) a b. + Foldable t => + (a -> b -> b) -> b -> t a -> b + with foldr @[] @Integer @Integer + (imported from ‘Prelude’ at refinement_hole_fits.hs:1:8-30 + (and originally defined in ‘Data.Foldable’)) + curry (_ :: (Integer, [Integer]) -> Integer) + where curry :: forall a b c. ((a, b) -> c) -> a -> b -> c + with curry @Integer @[Integer] @Integer + (imported from ‘Prelude’ at refinement_hole_fits.hs:1:8-30 + (and originally defined in ‘Data.Tuple’)) + flip (_ :: [Integer] -> Integer -> Integer) + where flip :: forall a b c. (a -> b -> c) -> b -> a -> c + with flip @[Integer] @Integer @Integer + (imported from ‘Prelude’ at refinement_hole_fits.hs:1:8-30 + (and originally defined in ‘GHC.Base’)) + const (_ :: [Integer] -> Integer) + where const :: forall a b. a -> b -> a + with const @([Integer] -> Integer) @Integer + (imported from ‘Prelude’ at refinement_hole_fits.hs:1:8-30 + (and originally defined in ‘GHC.Base’)) + ($) (_ :: Integer -> [Integer] -> Integer) + where ($) :: forall a b. (a -> b) -> a -> b + with ($) @'GHC.Types.LiftedRep @Integer @([Integer] -> Integer) + (imported from ‘Prelude’ at refinement_hole_fits.hs:1:8-30 + (and originally defined in ‘GHC.Base’)) + fail (_ :: String) + where fail :: forall (m :: * -> *) a. Monad m => String -> m a + with fail @((->) Integer) @([Integer] -> Integer) + (imported from ‘Prelude’ at refinement_hole_fits.hs:1:8-30 + (and originally defined in ‘GHC.Base’)) + return (_ :: [Integer] -> Integer) + where return :: forall (m :: * -> *) a. Monad m => a -> m a + with return @((->) Integer) @([Integer] -> Integer) + (imported from ‘Prelude’ at refinement_hole_fits.hs:1:8-30 + (and originally defined in ‘GHC.Base’)) + pure (_ :: [Integer] -> Integer) + where pure :: forall (f :: * -> *) a. Applicative f => a -> f a + with pure @((->) Integer) @([Integer] -> Integer) + (imported from ‘Prelude’ at refinement_hole_fits.hs:1:8-30 + (and originally defined in ‘GHC.Base’)) + ($!) (_ :: Integer -> [Integer] -> Integer) + where ($!) :: forall a b. (a -> b) -> a -> b + with ($!) @'GHC.Types.LiftedRep @Integer @([Integer] -> Integer) + (imported from ‘Prelude’ at refinement_hole_fits.hs:1:8-30 + (and originally defined in ‘GHC.Base’)) + id (_ :: Integer -> [Integer] -> Integer) + where id :: forall a. a -> a + with id @(Integer -> [Integer] -> Integer) + (imported from ‘Prelude’ at refinement_hole_fits.hs:1:8-30 + (and originally defined in ‘GHC.Base’)) + head (_ :: [Integer -> [Integer] -> Integer]) + where head :: forall a. [a] -> a + with head @(Integer -> [Integer] -> Integer) + (imported from ‘Prelude’ at refinement_hole_fits.hs:1:8-30 + (and originally defined in ‘GHC.List’)) + last (_ :: [Integer -> [Integer] -> Integer]) + where last :: forall a. [a] -> a + with last @(Integer -> [Integer] -> Integer) + (imported from ‘Prelude’ at refinement_hole_fits.hs:1:8-30 + (and originally defined in ‘GHC.List’)) + asTypeOf (_ :: Integer -> [Integer] -> Integer) + (_ :: Integer -> [Integer] -> Integer) + where asTypeOf :: forall a. a -> a -> a + with asTypeOf @(Integer -> [Integer] -> Integer) + (imported from ‘Prelude’ at refinement_hole_fits.hs:1:8-30 + (and originally defined in ‘GHC.Base’)) + (!!) (_ :: [Integer -> [Integer] -> Integer]) (_ :: Int) + where (!!) :: forall a. [a] -> Int -> a + with (!!) @(Integer -> [Integer] -> Integer) + (imported from ‘Prelude’ at refinement_hole_fits.hs:1:8-30 + (and originally defined in ‘GHC.List’)) diff --git a/testsuite/tests/typecheck/should_compile/subsumption_sort_hole_fits.hs b/testsuite/tests/typecheck/should_compile/subsumption_sort_hole_fits.hs new file mode 100755 index 0000000000..bda1b3de82 --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/subsumption_sort_hole_fits.hs @@ -0,0 +1,5 @@ +f :: [String] +f = _ "hello, world" + +main :: IO () +main = return () diff --git a/testsuite/tests/typecheck/should_compile/subsumption_sort_hole_fits.stderr b/testsuite/tests/typecheck/should_compile/subsumption_sort_hole_fits.stderr new file mode 100644 index 0000000000..7751113761 --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/subsumption_sort_hole_fits.stderr @@ -0,0 +1,39 @@ + +subsumption_sort_hole_fits.hs:2:5: warning: [-Wtyped-holes (in -Wdefault)] + • Found hole: _ :: [Char] -> [String] + • In the expression: _ + In the expression: _ "hello, world" + In an equation for ‘f’: f = _ "hello, world" + • Relevant bindings include + f :: [String] (bound at subsumption_sort_hole_fits.hs:2:1) + Valid hole fits include + lines :: String -> [String] + (imported from ‘Prelude’ at subsumption_sort_hole_fits.hs:1:1 + (and originally defined in ‘base-4.12.0.0:Data.OldList’)) + words :: String -> [String] + (imported from ‘Prelude’ at subsumption_sort_hole_fits.hs:1:1 + (and originally defined in ‘base-4.12.0.0:Data.OldList’)) + read :: forall a. Read a => String -> a + with read @[String] + (imported from ‘Prelude’ at subsumption_sort_hole_fits.hs:1:1 + (and originally defined in ‘Text.Read’)) + repeat :: forall a. a -> [a] + with repeat @String + (imported from ‘Prelude’ at subsumption_sort_hole_fits.hs:1:1 + (and originally defined in ‘GHC.List’)) + mempty :: forall a. Monoid a => a + with mempty @([Char] -> [String]) + (imported from ‘Prelude’ at subsumption_sort_hole_fits.hs:1:1 + (and originally defined in ‘GHC.Base’)) + return :: forall (m :: * -> *) a. Monad m => a -> m a + with return @[] @String + (imported from ‘Prelude’ at subsumption_sort_hole_fits.hs:1:1 + (and originally defined in ‘GHC.Base’)) + pure :: forall (f :: * -> *) a. Applicative f => a -> f a + with pure @[] @String + (imported from ‘Prelude’ at subsumption_sort_hole_fits.hs:1:1 + (and originally defined in ‘GHC.Base’)) + fail :: forall (m :: * -> *) a. Monad m => String -> m a + with fail @[] @String + (imported from ‘Prelude’ at subsumption_sort_hole_fits.hs:1:1 + (and originally defined in ‘GHC.Base’)) diff --git a/testsuite/tests/typecheck/should_compile/tc141.stderr b/testsuite/tests/typecheck/should_compile/tc141.stderr index 9c13f1791d..f0cfdefd03 100644 --- a/testsuite/tests/typecheck/should_compile/tc141.stderr +++ b/testsuite/tests/typecheck/should_compile/tc141.stderr @@ -8,11 +8,13 @@ tc141.hs:11:12: error: tc141.hs:11:31: error: • Couldn't match expected type ‘a2’ with actual type ‘a’ - because type variable ‘a2’ would escape its scope - This (rigid, skolem) type variable is bound by + ‘a2’ is a rigid type variable bound by an expression type signature: forall a2. a2 at tc141.hs:11:34 + ‘a’ is a rigid type variable bound by + the inferred type of f :: (a, a) -> (a1, a) + at tc141.hs:11:1-37 • In the expression: q :: a In the expression: (q :: a, p) In the expression: let (p :: a, q :: a) = x in (q :: a, p) @@ -35,12 +37,14 @@ tc141.hs:13:13: error: in v tc141.hs:15:18: error: - • Couldn't match expected type ‘a2’ with actual type ‘p’ - because type variable ‘a2’ would escape its scope - This (rigid, skolem) type variable is bound by + • Couldn't match expected type ‘a1’ with actual type ‘p1’ + ‘a1’ is a rigid type variable bound by the type signature for: - v :: forall a2. a2 + v :: forall a1. a1 at tc141.hs:14:14-19 + ‘p1’ is a rigid type variable bound by + the inferred type of g :: p -> p1 -> a + at tc141.hs:(13,1)-(16,13) • In the expression: b In an equation for ‘v’: v = b In the expression: @@ -49,6 +53,6 @@ tc141.hs:15:18: error: v = b in v • Relevant bindings include - v :: a2 (bound at tc141.hs:15:14) - b :: p (bound at tc141.hs:13:5) - g :: a -> p -> a1 (bound at tc141.hs:13:1) + v :: a1 (bound at tc141.hs:15:14) + b :: p1 (bound at tc141.hs:13:5) + g :: p -> p1 -> a (bound at tc141.hs:13:1) diff --git a/testsuite/tests/typecheck/should_compile/tc191.hs b/testsuite/tests/typecheck/should_compile/tc191.hs index 403ec88da9..c7a7c3e4c6 100644 --- a/testsuite/tests/typecheck/should_compile/tc191.hs +++ b/testsuite/tests/typecheck/should_compile/tc191.hs @@ -1,4 +1,4 @@ - +{-# LANGUAGE RankNTypes #-} -- This only typechecks if forall-hoisting works ok when -- importing from an interface file. The type of Twins.gzipWithQ diff --git a/testsuite/tests/typecheck/should_compile/tc205.hs b/testsuite/tests/typecheck/should_compile/tc205.hs index 1fe2cc255f..e45660fb3a 100644 --- a/testsuite/tests/typecheck/should_compile/tc205.hs +++ b/testsuite/tests/typecheck/should_compile/tc205.hs @@ -4,7 +4,9 @@ module ShouldCompile where +import Data.Kind + infix 1 `DArrowX` -- (->) has precedence 0 -data DArrowX :: * -> * -> * where +data DArrowX :: Type -> Type -> Type where First :: a `DArrowX` a' -> (a,b) `DArrowX` (a',b) diff --git a/testsuite/tests/typecheck/should_compile/tc211.stderr b/testsuite/tests/typecheck/should_compile/tc211.stderr index c57c59b3fc..3342cf72e3 100644 --- a/testsuite/tests/typecheck/should_compile/tc211.stderr +++ b/testsuite/tests/typecheck/should_compile/tc211.stderr @@ -1,7 +1,7 @@ tc211.hs:20:8: error: • Couldn't match expected type ‘forall a. a -> a’ - with actual type ‘a1 -> a1’ + with actual type ‘a3 -> a3’ • In the expression: (:) :: (forall a. a -> a) -> [forall a. a -> a] -> [forall a. a -> a] @@ -16,15 +16,15 @@ tc211.hs:20:8: error: (head foo) foo tc211.hs:25:8: error: - • Couldn't match type ‘a3 -> a3’ with ‘forall a. a -> a’ + • Couldn't match type ‘a1 -> a1’ with ‘forall a. a -> a’ Expected type: [forall a. a -> a] - Actual type: [a3 -> a3] + Actual type: [a1 -> a1] • In the expression: (head foo) : (tail foo) In an equation for ‘barr’: barr = (head foo) : (tail foo) tc211.hs:25:20: error: - • Couldn't match type ‘forall a. a -> a’ with ‘a3 -> a3’ - Expected type: [a3 -> a3] + • Couldn't match type ‘forall a. a -> a’ with ‘a1 -> a1’ + Expected type: [a1 -> a1] Actual type: [forall a. a -> a] • In the second argument of ‘(:)’, namely ‘(tail foo)’ In the expression: (head foo) : (tail foo) @@ -32,7 +32,7 @@ tc211.hs:25:20: error: tc211.hs:62:18: error: • Couldn't match expected type ‘forall a. a -> a’ - with actual type ‘a0 -> a0’ + with actual type ‘a2 -> a2’ • In the expression: Cons :: (forall a. a -> a) @@ -52,21 +52,21 @@ tc211.hs:62:18: error: tc211.hs:68:8: error: • Couldn't match expected type ‘forall a. a -> a’ - with actual type ‘a2 -> a2’ + with actual type ‘a0 -> a0’ • In the expression: Cons :: ((forall a. a -> a) - -> List (forall a. a -> a) -> List (forall a. a -> a)) + -> List (forall a. a -> a) -> List (forall a. a -> a)) In the expression: (Cons :: ((forall a. a -> a) - -> List (forall a. a -> a) -> List (forall a. a -> a))) + -> List (forall a. a -> a) -> List (forall a. a -> a))) (\ x -> x) Nil In an equation for ‘xs2’: xs2 = (Cons :: ((forall a. a -> a) - -> List (forall a. a -> a) -> List (forall a. a -> a))) + -> List (forall a. a -> a) -> List (forall a. a -> a))) (\ x -> x) Nil tc211.hs:76:9: error: diff --git a/testsuite/tests/typecheck/should_compile/tc231.stderr b/testsuite/tests/typecheck/should_compile/tc231.stderr index 4962bfde26..485370c1e7 100644 --- a/testsuite/tests/typecheck/should_compile/tc231.stderr +++ b/testsuite/tests/typecheck/should_compile/tc231.stderr @@ -5,8 +5,7 @@ TYPE SIGNATURES forall s b chain. Zork s (Z [Char]) b => Q s (Z [Char]) chain -> ST s () - huh :: - forall s a b. Zork s a b => forall chain. Q s a chain -> ST s () + huh :: forall s a b chain. Zork s a b => Q s a chain -> ST s () s :: forall t t1. Q t (Z [Char]) t1 -> Q t (Z [Char]) t1 TYPE CONSTRUCTORS data Q s a chain = Node s a chain @@ -19,5 +18,5 @@ COERCION AXIOMS Zork s a b = forall chain. Q s a chain -> ST s () -- Defined at tc231.hs:25:1 Dependent modules: [] -Dependent packages: [base-4.10.0.0, ghc-prim-0.5.1.0, - integer-gmp-1.0.0.1] +Dependent packages: [base-4.12.0.0, ghc-prim-0.5.3, + integer-simple-0.1.1.1] diff --git a/testsuite/tests/typecheck/should_compile/tc247.hs b/testsuite/tests/typecheck/should_compile/tc247.hs index 0f017a02db..abfc9ac9a4 100644 --- a/testsuite/tests/typecheck/should_compile/tc247.hs +++ b/testsuite/tests/typecheck/should_compile/tc247.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE EmptyDataDecls, KindSignatures #-} +{-# LANGUAGE GADTs, EmptyDataDecls, KindSignatures #-} module ShouldCompile where diff --git a/testsuite/tests/typecheck/should_compile/tc269.hs b/testsuite/tests/typecheck/should_compile/tc269.hs index 33151cebe8..3ac88ce8e9 100644 --- a/testsuite/tests/typecheck/should_compile/tc269.hs +++ b/testsuite/tests/typecheck/should_compile/tc269.hs @@ -1,6 +1,5 @@ {-# LANGUAGE RankNTypes #-} -{-# LANGUAGE KindSignatures #-} -{-# LANGUAGE TypeInType #-} +{-# LANGUAGE PolyKinds #-} module Tc269 where import GHC.Types diff --git a/testsuite/tests/typecheck/should_compile/type_in_type_hole_fits.hs b/testsuite/tests/typecheck/should_compile/type_in_type_hole_fits.hs new file mode 100644 index 0000000000..566f8aa102 --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/type_in_type_hole_fits.hs @@ -0,0 +1,88 @@ +{-# LANGUAGE TypeInType, TypeOperators, TypeFamilies, + UndecidableInstances, ConstraintKinds #-} +module TypeInTypeSubstitutions where + +import GHC.TypeLits as L +import Data.Type.Bool +import Data.Type.Equality +import Data.List (sort) + + +-- We define a very simplistic O notation, with sufficient expressiveness +-- to capture the complexity of a few simple sorting algorithms +data AsympPoly = NLogN Nat Nat + +-- Synonyms for common terms +type N = NLogN 1 0 +type LogN = NLogN 0 1 +type One = NLogN 0 0 + +-- Just to be able to write it nicely +type O (a :: AsympPoly) = a + +type family (^.) (n :: AsympPoly) (m :: Nat) :: AsympPoly where + (NLogN a b) ^. n = (NLogN (a L.* n) (b L.* n)) + +type family (*.) (n :: AsympPoly) (m :: AsympPoly) :: AsympPoly where + (NLogN a b) *. (NLogN c d) = NLogN (a+c) (b+d) + +type family OCmp (n :: AsympPoly) (m :: AsympPoly) :: Ordering where + OCmp (NLogN a b) (NLogN c d) = If (CmpNat a c == EQ) + (CmpNat b d) + (CmpNat a c) + +type family OGEq (n :: AsympPoly) (m :: AsympPoly) :: Bool where + OGEq n m = Not (OCmp n m == 'LT) + +type (>=.) n m = OGEq n m ~ True + +infix 4 >=. +infixl 7 *., ^. + + + +-- Stable sorts must be stable, but unstable can be, but don't need to. +type IsStable s = (s || True) ~ True +-- We encode in the return type of the sorting function its average complexity, +-- memory use and stability. +newtype Sorted (cpu :: AsympPoly) -- The minimum operational complexity + -- this algorithm satisfies. + (mem :: AsympPoly) -- The minimum space complexity this + -- algorithm satisfies. + (stable :: Bool) -- Whether the sort is stable or not. + a -- What was being sorted. + = Sorted {sortedBy :: [a]} + +-- Merge sort is O(N*Log(N)) on average in complexity, so that's the +-- minimum complexity we promise to satisfy. Same goes with memory, which is +-- O(N), and as we all know, mergesort is a stable sorting algoritm. +mergeSort :: (Ord a, n >=. O(N*.LogN), m >=. O(N), IsStable s) => + [a] -> Sorted n m s a +mergeSort = Sorted . sort + +insertionSort :: (Ord a, n >=. O(N^.2), m >=. O(One), IsStable s) => + [a] -> Sorted n m s a +insertionSort = Sorted . sort + +-- Note that we don't actually check the complexity (as evidenced by them all +-- being implemented with sort, a smooth applicative merge sort). With more +-- dependent types however, some of these properties might be verifiable. +quickSort :: (Ord a, n >=. O(N*.LogN), m >=. O(N)) => [a] -> Sorted n m False a +quickSort = Sorted . sort + +heapSort :: (Ord a, n >=. O(N*.LogN), m >=. O(One)) => [a] -> Sorted n m False a +heapSort = Sorted . sort + +-- Here we say that sorted can use at most operational complexity O(N^2), space +-- complexity of at most (O(N)) and that it should be stable. +mySortA :: Sorted (O(N^.2)) (O(N)) True Integer +mySortA = _a [3,1,2] + +mySortB :: Sorted (O(N*.LogN)) (O(N)) False Integer +mySortB = _b [3,1,2] + +mySortC :: Sorted (O(N*.LogN)) (O(One)) False Integer +mySortC = _c [3,1,2] + +main :: IO () +main = print (sortedBy mySortA) diff --git a/testsuite/tests/typecheck/should_compile/type_in_type_hole_fits.stderr b/testsuite/tests/typecheck/should_compile/type_in_type_hole_fits.stderr new file mode 100644 index 0000000000..ec1b0dd4f1 --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/type_in_type_hole_fits.stderr @@ -0,0 +1,78 @@ + +type_in_type_hole_fits.hs:79:11: warning: [-Wtyped-holes (in -Wdefault)] + • Found hole: + _a :: [Integer] -> Sorted (O ('NLogN 2 0)) (O N) 'True Integer + Or perhaps ‘_a’ is mis-spelled, or not in scope + • In the expression: _a + In the expression: _a [3, 1, 2] + In an equation for ‘mySortA’: mySortA = _a [3, 1, 2] + • Relevant bindings include + mySortA :: Sorted (O (N ^. 2)) (O N) 'True Integer + (bound at type_in_type_hole_fits.hs:79:1) + Valid hole fits include + mergeSort :: forall a (n :: AsympPoly) (m :: AsympPoly) (s :: Bool). + (Ord a, n >=. O (N *. LogN), m >=. O N, IsStable s) => + [a] -> Sorted n m s a + with mergeSort @Integer @(O ('NLogN 2 0)) @(O N) @'True + (defined at type_in_type_hole_fits.hs:61:1) + insertionSort :: forall a (n :: AsympPoly) (m :: AsympPoly) (s :: Bool). + (Ord a, n >=. O (N ^. 2), m >=. O One, IsStable s) => + [a] -> Sorted n m s a + with insertionSort @Integer @(O ('NLogN 2 0)) @(O N) @'True + (defined at type_in_type_hole_fits.hs:65:1) + Sorted :: forall (cpu :: AsympPoly) (mem :: AsympPoly) (stable :: Bool) a. + [a] -> Sorted cpu mem stable a + with Sorted @(O ('NLogN 2 0)) @(O N) @'True @Integer + (defined at type_in_type_hole_fits.hs:54:18) + +type_in_type_hole_fits.hs:82:11: warning: [-Wtyped-holes (in -Wdefault)] + • Found hole: + _b :: [Integer] -> Sorted (O ('NLogN 1 1)) (O N) 'False Integer + Or perhaps ‘_b’ is mis-spelled, or not in scope + • In the expression: _b + In the expression: _b [3, 1, 2] + In an equation for ‘mySortB’: mySortB = _b [3, 1, 2] + • Relevant bindings include + mySortB :: Sorted (O (N *. LogN)) (O N) 'False Integer + (bound at type_in_type_hole_fits.hs:82:1) + Valid hole fits include + quickSort :: forall a (n :: AsympPoly) (m :: AsympPoly). + (Ord a, n >=. O (N *. LogN), m >=. O N) => + [a] -> Sorted n m 'False a + with quickSort @Integer @(O ('NLogN 1 1)) @(O N) + (defined at type_in_type_hole_fits.hs:71:1) + heapSort :: forall a (n :: AsympPoly) (m :: AsympPoly). + (Ord a, n >=. O (N *. LogN), m >=. O One) => + [a] -> Sorted n m 'False a + with heapSort @Integer @(O ('NLogN 1 1)) @(O N) + (defined at type_in_type_hole_fits.hs:74:1) + mergeSort :: forall a (n :: AsympPoly) (m :: AsympPoly) (s :: Bool). + (Ord a, n >=. O (N *. LogN), m >=. O N, IsStable s) => + [a] -> Sorted n m s a + with mergeSort @Integer @(O ('NLogN 1 1)) @(O N) @'False + (defined at type_in_type_hole_fits.hs:61:1) + Sorted :: forall (cpu :: AsympPoly) (mem :: AsympPoly) (stable :: Bool) a. + [a] -> Sorted cpu mem stable a + with Sorted @(O ('NLogN 1 1)) @(O N) @'False @Integer + (defined at type_in_type_hole_fits.hs:54:18) + +type_in_type_hole_fits.hs:85:11: warning: [-Wtyped-holes (in -Wdefault)] + • Found hole: + _c :: [Integer] -> Sorted (O ('NLogN 1 1)) (O One) 'False Integer + Or perhaps ‘_c’ is mis-spelled, or not in scope + • In the expression: _c + In the expression: _c [3, 1, 2] + In an equation for ‘mySortC’: mySortC = _c [3, 1, 2] + • Relevant bindings include + mySortC :: Sorted (O (N *. LogN)) (O One) 'False Integer + (bound at type_in_type_hole_fits.hs:85:1) + Valid hole fits include + heapSort :: forall a (n :: AsympPoly) (m :: AsympPoly). + (Ord a, n >=. O (N *. LogN), m >=. O One) => + [a] -> Sorted n m 'False a + with heapSort @Integer @(O ('NLogN 1 1)) @(O One) + (defined at type_in_type_hole_fits.hs:74:1) + Sorted :: forall (cpu :: AsympPoly) (mem :: AsympPoly) (stable :: Bool) a. + [a] -> Sorted cpu mem stable a + with Sorted @(O ('NLogN 1 1)) @(O One) @'False @Integer + (defined at type_in_type_hole_fits.hs:54:18) diff --git a/testsuite/tests/typecheck/should_compile/valid_hole_fits.hs b/testsuite/tests/typecheck/should_compile/valid_hole_fits.hs new file mode 100644 index 0000000000..39939ba692 --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/valid_hole_fits.hs @@ -0,0 +1,37 @@ +module Foo where + +import Prelude hiding (putStr, putStrLn) +import qualified System.IO (putStr, putStrLn) +import Data.Maybe +import qualified ValidHoleFits + +ps :: String -> IO () +ps = putStrLn + +a :: Int -> IO Int +a _ = return 1 +b :: Int -> IO Int +b _ = return 2 +c :: Int -> IO Int +c _ = do { x <- a 0 + ; y <- _ x + ; return y } + +test :: [Maybe a] -> [a] +test = _ + +test2 :: Integer -> ValidHoleFits.Moo +test2 = _ + +k :: Maybe Integer +k = _ 2 + +f :: String +f = show _ + + +h :: String +h = show (_ (_ :: Bool)) + +main :: IO () +main = _ "hello, world" diff --git a/testsuite/tests/typecheck/should_compile/valid_hole_fits.stderr b/testsuite/tests/typecheck/should_compile/valid_hole_fits.stderr new file mode 100644 index 0000000000..93de053f54 --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/valid_hole_fits.stderr @@ -0,0 +1,225 @@ +[1 of 2] Compiling ValidHoleFits ( ValidHoleFits.hs, ValidHoleFits.o ) +[2 of 2] Compiling Foo ( valid_hole_fits.hs, valid_hole_fits.o ) + +valid_hole_fits.hs:9:6: warning: [-Wdeferred-out-of-scope-variables (in -Wdefault)] + • Variable not in scope: putStrLn :: String -> IO () + • Perhaps you meant one of these: + ‘System.IO.putStrLn’ (imported from System.IO), + ‘System.IO.putStr’ (imported from System.IO) + Perhaps you want to remove ‘putStrLn’ from the explicit hiding list + in the import of ‘Prelude’ (valid_hole_fits.hs:3:1-40). + +valid_hole_fits.hs:17:17: warning: [-Wtyped-holes (in -Wdefault)] + • Found hole: _ :: Int -> IO Int + • In the expression: _ + In a stmt of a 'do' block: y <- _ x + In the expression: + do x <- a 0 + y <- _ x + return y + • Relevant bindings include + x :: Int (bound at valid_hole_fits.hs:16:12) + c :: Int -> IO Int (bound at valid_hole_fits.hs:16:1) + Valid hole fits include + c :: Int -> IO Int (bound at valid_hole_fits.hs:16:1) + a :: Int -> IO Int (bound at valid_hole_fits.hs:12:1) + b :: Int -> IO Int (bound at valid_hole_fits.hs:14:1) + return :: forall (m :: * -> *) a. Monad m => a -> m a + with return @IO @Int + (imported from ‘Prelude’ at valid_hole_fits.hs:3:1-40 + (and originally defined in ‘GHC.Base’)) + pure :: forall (f :: * -> *) a. Applicative f => a -> f a + with pure @IO @Int + (imported from ‘Prelude’ at valid_hole_fits.hs:3:1-40 + (and originally defined in ‘GHC.Base’)) + +valid_hole_fits.hs:21:8: warning: [-Wtyped-holes (in -Wdefault)] + • Found hole: _ :: [Maybe a] -> [a] + Where: ‘a’ is a rigid type variable bound by + the type signature for: + test :: forall a. [Maybe a] -> [a] + at valid_hole_fits.hs:20:1-24 + • In the expression: _ + In an equation for ‘test’: test = _ + • Relevant bindings include + test :: [Maybe a] -> [a] (bound at valid_hole_fits.hs:21:1) + Valid hole fits include + test :: [Maybe a] -> [a] (bound at valid_hole_fits.hs:21:1) + catMaybes :: forall a. [Maybe a] -> [a] + with catMaybes @a + (imported from ‘Data.Maybe’ at valid_hole_fits.hs:5:1-17) + mempty :: forall a. Monoid a => a + with mempty @([Maybe a] -> [a]) + (imported from ‘Prelude’ at valid_hole_fits.hs:3:1-40 + (and originally defined in ‘GHC.Base’)) + +valid_hole_fits.hs:24:9: warning: [-Wtyped-holes (in -Wdefault)] + • Found hole: _ :: Integer -> ValidHoleFits.Moo + • In the expression: _ + In an equation for ‘test2’: test2 = _ + • Relevant bindings include + test2 :: Integer -> ValidHoleFits.Moo + (bound at valid_hole_fits.hs:24:1) + Valid hole fits include + test2 :: Integer -> ValidHoleFits.Moo + (bound at valid_hole_fits.hs:24:1) + ValidHoleFits.Moo :: Integer -> ValidHoleFits.Moo + (imported qualified from ‘ValidHoleFits’ at valid_hole_fits.hs:6:1-30 + (and originally defined at ValidHoleFits.hs:4:12-22)) + +valid_hole_fits.hs:27:5: warning: [-Wtyped-holes (in -Wdefault)] + • Found hole: _ :: Integer -> Maybe Integer + • In the expression: _ + In the expression: _ 2 + In an equation for ‘k’: k = _ 2 + • Relevant bindings include + k :: Maybe Integer (bound at valid_hole_fits.hs:27:1) + Valid hole fits include + Just :: forall a. a -> Maybe a + with Just @Integer + (imported from ‘Data.Maybe’ at valid_hole_fits.hs:5:1-17 + (and originally defined in ‘GHC.Maybe’)) + return :: forall (m :: * -> *) a. Monad m => a -> m a + with return @Maybe @Integer + (imported from ‘Prelude’ at valid_hole_fits.hs:3:1-40 + (and originally defined in ‘GHC.Base’)) + pure :: forall (f :: * -> *) a. Applicative f => a -> f a + with pure @Maybe @Integer + (imported from ‘Prelude’ at valid_hole_fits.hs:3:1-40 + (and originally defined in ‘GHC.Base’)) + +valid_hole_fits.hs:30:10: warning: [-Wtyped-holes (in -Wdefault)] + • Found hole: _ :: a1 + Where: ‘a1’ is an ambiguous type variable + • In the first argument of ‘show’, namely ‘_’ + In the expression: show _ + In an equation for ‘f’: f = show _ + • Relevant bindings include + f :: String (bound at valid_hole_fits.hs:30:1) + Valid hole fits include + f :: String (bound at valid_hole_fits.hs:30:1) + k :: Maybe Integer (defined at valid_hole_fits.hs:27:1) + h :: String (bound at valid_hole_fits.hs:34:1) + otherwise :: Bool + (imported from ‘Prelude’ at valid_hole_fits.hs:3:1-40 + (and originally defined in ‘GHC.Base’)) + False :: Bool + (imported from ‘Prelude’ at valid_hole_fits.hs:3:1-40 + (and originally defined in ‘GHC.Types’)) + True :: Bool + (imported from ‘Prelude’ at valid_hole_fits.hs:3:1-40 + (and originally defined in ‘GHC.Types’)) + EQ :: Ordering + (imported from ‘Prelude’ at valid_hole_fits.hs:3:1-40 + (and originally defined in ‘GHC.Types’)) + LT :: Ordering + (imported from ‘Prelude’ at valid_hole_fits.hs:3:1-40 + (and originally defined in ‘GHC.Types’)) + GT :: Ordering + (imported from ‘Prelude’ at valid_hole_fits.hs:3:1-40 + (and originally defined in ‘GHC.Types’)) + pi :: forall a. Floating a => a + with pi @Double + (imported from ‘Prelude’ at valid_hole_fits.hs:3:1-40 + (and originally defined in ‘GHC.Float’)) + +valid_hole_fits.hs:34:11: warning: [-Wtyped-holes (in -Wdefault)] + • Found hole: _ :: Bool -> a0 + Where: ‘a0’ is an ambiguous type variable + • In the expression: _ + In the first argument of ‘show’, namely ‘(_ (_ :: Bool))’ + In the expression: show (_ (_ :: Bool)) + • Relevant bindings include + h :: String (bound at valid_hole_fits.hs:34:1) + Valid hole fits include + not :: Bool -> Bool + (imported from ‘Prelude’ at valid_hole_fits.hs:3:1-40 + (and originally defined in ‘GHC.Classes’)) + enumFrom :: forall a. Enum a => a -> [a] + with enumFrom @Bool + (imported from ‘Prelude’ at valid_hole_fits.hs:3:1-40 + (and originally defined in ‘GHC.Enum’)) + Just :: forall a. a -> Maybe a + with Just @Bool + (imported from ‘Data.Maybe’ at valid_hole_fits.hs:5:1-17 + (and originally defined in ‘GHC.Maybe’)) + id :: forall a. a -> a + with id @Bool + (imported from ‘Prelude’ at valid_hole_fits.hs:3:1-40 + (and originally defined in ‘GHC.Base’)) + repeat :: forall a. a -> [a] + with repeat @Bool + (imported from ‘Prelude’ at valid_hole_fits.hs:3:1-40 + (and originally defined in ‘GHC.List’)) + fromEnum :: forall a. Enum a => a -> Int + with fromEnum @Bool + (imported from ‘Prelude’ at valid_hole_fits.hs:3:1-40 + (and originally defined in ‘GHC.Enum’)) + pred :: forall a. Enum a => a -> a + with pred @Bool + (imported from ‘Prelude’ at valid_hole_fits.hs:3:1-40 + (and originally defined in ‘GHC.Enum’)) + succ :: forall a. Enum a => a -> a + with succ @Bool + (imported from ‘Prelude’ at valid_hole_fits.hs:3:1-40 + (and originally defined in ‘GHC.Enum’)) + show :: forall a. Show a => a -> String + with show @Bool + (imported from ‘Prelude’ at valid_hole_fits.hs:3:1-40 + (and originally defined in ‘GHC.Show’)) + +valid_hole_fits.hs:34:14: warning: [-Wtyped-holes (in -Wdefault)] + • Found hole: _ :: Bool + • In the first argument of ‘_’, namely ‘(_ :: Bool)’ + In the first argument of ‘show’, namely ‘(_ (_ :: Bool))’ + In the expression: show (_ (_ :: Bool)) + • Relevant bindings include + h :: String (bound at valid_hole_fits.hs:34:1) + Valid hole fits include + otherwise :: Bool + (imported from ‘Prelude’ at valid_hole_fits.hs:3:1-40 + (and originally defined in ‘GHC.Base’)) + False :: Bool + (imported from ‘Prelude’ at valid_hole_fits.hs:3:1-40 + (and originally defined in ‘GHC.Types’)) + True :: Bool + (imported from ‘Prelude’ at valid_hole_fits.hs:3:1-40 + (and originally defined in ‘GHC.Types’)) + maxBound :: forall a. Bounded a => a + with maxBound @Bool + (imported from ‘Prelude’ at valid_hole_fits.hs:3:1-40 + (and originally defined in ‘GHC.Enum’)) + minBound :: forall a. Bounded a => a + with minBound @Bool + (imported from ‘Prelude’ at valid_hole_fits.hs:3:1-40 + (and originally defined in ‘GHC.Enum’)) + +valid_hole_fits.hs:37:8: warning: [-Wtyped-holes (in -Wdefault)] + • Found hole: _ :: [Char] -> IO () + • In the expression: _ + In the expression: _ "hello, world" + In an equation for ‘main’: main = _ "hello, world" + • Relevant bindings include + main :: IO () (bound at valid_hole_fits.hs:37:1) + Valid hole fits include + ps :: String -> IO () (defined at valid_hole_fits.hs:9:1) + System.IO.putStr :: String -> IO () + (imported qualified from ‘System.IO’ at valid_hole_fits.hs:4:29-34) + System.IO.putStrLn :: String -> IO () + (imported qualified from ‘System.IO’ at valid_hole_fits.hs:4:37-44) + readIO :: forall a. Read a => String -> IO a + with readIO @() + (imported from ‘Prelude’ at valid_hole_fits.hs:3:1-40 + (and originally defined in ‘System.IO’)) + print :: forall a. Show a => a -> IO () + with print @[Char] + (imported from ‘Prelude’ at valid_hole_fits.hs:3:1-40 + (and originally defined in ‘System.IO’)) + fail :: forall (m :: * -> *) a. Monad m => String -> m a + with fail @IO @() + (imported from ‘Prelude’ at valid_hole_fits.hs:3:1-40 + (and originally defined in ‘GHC.Base’)) + mempty :: forall a. Monoid a => a + with mempty @([Char] -> IO ()) + (imported from ‘Prelude’ at valid_hole_fits.hs:3:1-40 + (and originally defined in ‘GHC.Base’)) diff --git a/testsuite/tests/typecheck/should_compile/valid_hole_fits_interactions.hs b/testsuite/tests/typecheck/should_compile/valid_hole_fits_interactions.hs new file mode 100644 index 0000000000..069e1f7384 --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/valid_hole_fits_interactions.hs @@ -0,0 +1,15 @@ +{-# LANGUAGE GADTs #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE TypeFamilies #-} + +module ValidSubsInteractions where + +import Data.Kind + + +data SBool :: Bool -> Type where + SFalse :: SBool 'False + STrue :: SBool 'True + +f :: SBool 'True +f = _ diff --git a/testsuite/tests/typecheck/should_compile/valid_hole_fits_interactions.stderr b/testsuite/tests/typecheck/should_compile/valid_hole_fits_interactions.stderr new file mode 100644 index 0000000000..ac4fdc94c7 --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/valid_hole_fits_interactions.stderr @@ -0,0 +1,11 @@ + +valid_hole_fits_interactions.hs:15:5: warning: [-Wtyped-holes (in -Wdefault)] + • Found hole: _ :: SBool 'True + • In the expression: _ + In an equation for ‘f’: f = _ + • Relevant bindings include + f :: SBool 'True (bound at valid_hole_fits_interactions.hs:15:1) + Valid hole fits include + f :: SBool 'True (bound at valid_hole_fits_interactions.hs:15:1) + STrue :: SBool 'True + (defined at valid_hole_fits_interactions.hs:12:3) diff --git a/testsuite/tests/typecheck/should_compile/valid_substitutions.hs b/testsuite/tests/typecheck/should_compile/valid_substitutions.hs deleted file mode 100644 index bae315b8e8..0000000000 --- a/testsuite/tests/typecheck/should_compile/valid_substitutions.hs +++ /dev/null @@ -1,19 +0,0 @@ -module Foo where - -import Prelude hiding (putStr) -import qualified System.IO -import Data.Maybe -import qualified ValidSubs - -ps :: String -> IO () -ps = putStrLn - - -test :: [Maybe a] -> [a] -test = _ - -test2 :: Integer -> ValidSubs.Moo -test2 = _ - -main :: IO () -main = _ "hello, world" diff --git a/testsuite/tests/typecheck/should_compile/valid_substitutions.stderr b/testsuite/tests/typecheck/should_compile/valid_substitutions.stderr deleted file mode 100644 index a89c5f03a8..0000000000 --- a/testsuite/tests/typecheck/should_compile/valid_substitutions.stderr +++ /dev/null @@ -1,37 +0,0 @@ -[1 of 2] Compiling ValidSubs ( ValidSubs.hs, ValidSubs.o ) -[2 of 2] Compiling Foo ( valid_substitutions.hs, valid_substitutions.o ) - -valid_substitutions.hs:13:8: warning: [-Wtyped-holes (in -Wdefault)] - • Found hole: _ :: [Maybe a] -> [a] - Where: ‘a’ is a rigid type variable bound by - the type signature for: - test :: forall a. [Maybe a] -> [a] - at valid_substitutions.hs:12:1-24 - • In the expression: _ - In an equation for ‘test’: test = _ - • Relevant bindings include - test :: [Maybe a] -> [a] (bound at valid_substitutions.hs:13:1) - -valid_substitutions.hs:16:9: warning: [-Wtyped-holes (in -Wdefault)] - • Found hole: _ :: Integer -> ValidSubs.Moo - • In the expression: _ - In an equation for ‘test2’: test2 = _ - • Relevant bindings include - test2 :: Integer -> ValidSubs.Moo - (bound at valid_substitutions.hs:16:1) - Valid substitutions include - ValidSubs.Moo :: Integer -> ValidSubs.Moo - -valid_substitutions.hs:19:8: warning: [-Wtyped-holes (in -Wdefault)] - • Found hole: _ :: [Char] -> IO () - • In the expression: _ - In the expression: _ "hello, world" - In an equation for ‘main’: main = _ "hello, world" - • Relevant bindings include - main :: IO () (bound at valid_substitutions.hs:19:1) - Valid substitutions include - ps :: String -> IO () (defined at valid_substitutions.hs:9:1) - System.IO.putStr :: String -> IO () - (imported qualified from ‘System.IO’ at valid_substitutions.hs:4:1-26) - putStrLn :: String -> IO () - (imported qualified from ‘System.IO’ at valid_substitutions.hs:4:1-26) diff --git a/testsuite/tests/typecheck/should_fail/ClassOperator.hs b/testsuite/tests/typecheck/should_fail/ClassOperator.hs index 6d41d113fb..922cbdb0f4 100644 --- a/testsuite/tests/typecheck/should_fail/ClassOperator.hs +++ b/testsuite/tests/typecheck/should_fail/ClassOperator.hs @@ -2,9 +2,11 @@ module ClassOperator where +import Data.Kind + -- | Class with fixity, including associated types class a ><> b where - type a <>< b :: * + type a <>< b :: Type data a ><< b (>><), (<<>) :: a -> b -> () diff --git a/testsuite/tests/typecheck/should_fail/ClassOperator.stderr b/testsuite/tests/typecheck/should_fail/ClassOperator.stderr index bc4eb7c598..78017f22ba 100644 --- a/testsuite/tests/typecheck/should_fail/ClassOperator.stderr +++ b/testsuite/tests/typecheck/should_fail/ClassOperator.stderr @@ -1,10 +1,10 @@ -ClassOperator.hs:12:3: error: +ClassOperator.hs:14:3: error: • Could not deduce (a ><> b0) from the context: a ><> b bound by the type signature for: (**>) :: forall a b. (a ><> b) => a -> a -> () - at ClassOperator.hs:12:3-44 + at ClassOperator.hs:14:3-44 The type variable ‘b0’ is ambiguous • In the ambiguity check for ‘**>’ To defer the ambiguity check to use sites, enable AllowAmbiguousTypes @@ -12,12 +12,12 @@ ClassOperator.hs:12:3: error: (**>) :: forall a b. (a ><> b) => a -> a -> () In the class declaration for ‘><>’ -ClassOperator.hs:12:3: error: +ClassOperator.hs:14:3: error: • Could not deduce (a ><> b0) from the context: a ><> b bound by the type signature for: (**<) :: forall a b. (a ><> b) => a -> a -> () - at ClassOperator.hs:12:3-44 + at ClassOperator.hs:14:3-44 The type variable ‘b0’ is ambiguous • In the ambiguity check for ‘**<’ To defer the ambiguity check to use sites, enable AllowAmbiguousTypes @@ -25,12 +25,12 @@ ClassOperator.hs:12:3: error: (**<) :: forall a b. (a ><> b) => a -> a -> () In the class declaration for ‘><>’ -ClassOperator.hs:12:3: error: +ClassOperator.hs:14:3: error: • Could not deduce (a ><> b0) from the context: a ><> b bound by the type signature for: (>**) :: forall a b. (a ><> b) => a -> a -> () - at ClassOperator.hs:12:3-44 + at ClassOperator.hs:14:3-44 The type variable ‘b0’ is ambiguous • In the ambiguity check for ‘>**’ To defer the ambiguity check to use sites, enable AllowAmbiguousTypes @@ -38,12 +38,12 @@ ClassOperator.hs:12:3: error: (>**) :: forall a b. (a ><> b) => a -> a -> () In the class declaration for ‘><>’ -ClassOperator.hs:12:3: error: +ClassOperator.hs:14:3: error: • Could not deduce (a ><> b0) from the context: a ><> b bound by the type signature for: (<**) :: forall a b. (a ><> b) => a -> a -> () - at ClassOperator.hs:12:3-44 + at ClassOperator.hs:14:3-44 The type variable ‘b0’ is ambiguous • In the ambiguity check for ‘<**’ To defer the ambiguity check to use sites, enable AllowAmbiguousTypes diff --git a/testsuite/tests/typecheck/should_fail/CustomTypeErrors04.hs b/testsuite/tests/typecheck/should_fail/CustomTypeErrors04.hs index d1957bf34b..298668f213 100644 --- a/testsuite/tests/typecheck/should_fail/CustomTypeErrors04.hs +++ b/testsuite/tests/typecheck/should_fail/CustomTypeErrors04.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE TypeInType, TypeFamilies, UndecidableInstances #-} +{-# LANGUAGE DataKinds, TypeFamilies, UndecidableInstances #-} {-# LANGUAGE UndecidableInstances #-} -- The "bad case" in #11391 diff --git a/testsuite/tests/typecheck/should_fail/CustomTypeErrors05.hs b/testsuite/tests/typecheck/should_fail/CustomTypeErrors05.hs index 5a15b6f363..7d200faef6 100644 --- a/testsuite/tests/typecheck/should_fail/CustomTypeErrors05.hs +++ b/testsuite/tests/typecheck/should_fail/CustomTypeErrors05.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE TypeInType, TypeFamilies, UndecidableInstances #-} +{-# LANGUAGE DataKinds, TypeFamilies, UndecidableInstances #-} {-# LANGUAGE UndecidableInstances #-} -- The "tricky case" in #11391 diff --git a/testsuite/tests/typecheck/should_fail/FrozenErrorTests.hs b/testsuite/tests/typecheck/should_fail/FrozenErrorTests.hs index 390333c1b2..ae29c2dc3c 100644 --- a/testsuite/tests/typecheck/should_fail/FrozenErrorTests.hs +++ b/testsuite/tests/typecheck/should_fail/FrozenErrorTests.hs @@ -1,23 +1,23 @@ {-# LANGUAGE RankNTypes, GADTs, TypeFamilies #-} -module Test where +module Test where -data T a where - MkT :: a -> T a - MkT3 :: forall a. (a ~ Bool) => T a +data T a where + MkT :: a -> T a + MkT3 :: forall a. (a ~ Bool) => T a --- Mismatches in givens -bloh :: T Int -> () -bloh x = case x of - MkT3 -> () +-- Mismatches in givens +bloh :: T Int -> () +bloh x = case x of + MkT3 -> () -type family F a b +type family F a b type family G a b -type instance F a Bool = a +type instance F a Bool = a type instance G a Char = a goo1 :: forall a b. (F a b ~ [a]) => b -> a -> a -goo1 = undefined +goo1 = undefined goo2 :: forall a. G a Char ~ [Int] => a -> a goo2 = undefined @@ -31,16 +31,16 @@ test3 = goo1 False (goo2 undefined) -- A frozen occurs check, now transformed to both a decomposition and occurs check -data M a where - M :: M a +data M a where + M :: M a data T2 a b where - T2 :: T2 a b + T2 :: T2 a b -goo3 :: forall a b. F a b ~ T2 (M a) a => b -> a -> a +goo3 :: forall a b. F a b ~ T2 (M a) a => b -> a -> a goo3 = undefined goo4 :: forall a c. G a Char ~ T2 (T2 c c) c => a -> a -goo4 = undefined +goo4 = undefined test4 = goo4 (goo3 False undefined) test5 = goo3 False (goo4 undefined) diff --git a/testsuite/tests/typecheck/should_fail/FrozenErrorTests.stderr b/testsuite/tests/typecheck/should_fail/FrozenErrorTests.stderr index 6abb044c8e..613d92b837 100644 --- a/testsuite/tests/typecheck/should_fail/FrozenErrorTests.stderr +++ b/testsuite/tests/typecheck/should_fail/FrozenErrorTests.stderr @@ -1,13 +1,4 @@ -FrozenErrorTests.hs:12:12: error: - • Couldn't match type ‘Int’ with ‘Bool’ - Inaccessible code in - a pattern with constructor: MkT3 :: forall a. (a ~ Bool) => T a, - in a case alternative - • In the pattern: MkT3 - In a case alternative: MkT3 -> () - In the expression: case x of { MkT3 -> () } - FrozenErrorTests.hs:26:9: error: • Occurs check: cannot construct the infinite type: a ~ [a] arising from a use of ‘goo1’ diff --git a/testsuite/tests/typecheck/should_fail/LevPolyBounded.hs b/testsuite/tests/typecheck/should_fail/LevPolyBounded.hs index 0607956784..0a68a69a38 100644 --- a/testsuite/tests/typecheck/should_fail/LevPolyBounded.hs +++ b/testsuite/tests/typecheck/should_fail/LevPolyBounded.hs @@ -1,6 +1,6 @@ -- inspired by comment:25 on #12708 -{-# LANGUAGE TypeInType #-} +{-# LANGUAGE PolyKinds #-} module LevPolyBounded where diff --git a/testsuite/tests/typecheck/should_fail/MissingExportList03.hs b/testsuite/tests/typecheck/should_fail/MissingExportList03.hs new file mode 100644 index 0000000000..4a5ecf0bcf --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/MissingExportList03.hs @@ -0,0 +1,5 @@ +{-# OPTIONS_GHC -Werror -fwarn-missing-export-lists #-} +module ShouldFail where + +foo :: String +foo = "foo" diff --git a/testsuite/tests/typecheck/should_fail/MissingExportList03.stderr b/testsuite/tests/typecheck/should_fail/MissingExportList03.stderr new file mode 100644 index 0000000000..897db53661 --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/MissingExportList03.stderr @@ -0,0 +1,3 @@ + +MissingExportList03.hs:1:1: error: [-Wmissing-export-lists, -Werror=missing-export-lists] + The export item ‘module ShouldFail’ is missing an export list diff --git a/testsuite/tests/typecheck/should_fail/T10619.stderr b/testsuite/tests/typecheck/should_fail/T10619.stderr index 0cd5364e2c..fde2daf8c6 100644 --- a/testsuite/tests/typecheck/should_fail/T10619.stderr +++ b/testsuite/tests/typecheck/should_fail/T10619.stderr @@ -1,6 +1,6 @@ T10619.hs:9:15: error: - • Couldn't match type ‘b -> b’ with ‘forall a. a -> a’ + • Couldn't match type ‘forall a. a -> a’ with ‘b -> b’ Expected type: (b -> b) -> b -> b Actual type: (forall a. a -> a) -> b -> b • In the expression: @@ -40,7 +40,7 @@ T10619.hs:14:15: error: bar :: p -> (b -> b) -> b -> b (bound at T10619.hs:12:1) T10619.hs:16:13: error: - • Couldn't match type ‘b -> b’ with ‘forall a. a -> a’ + • Couldn't match type ‘forall a. a -> a’ with ‘b -> b’ Expected type: (b -> b) -> b -> b Actual type: (forall a. a -> a) -> b -> b • In the expression: diff --git a/testsuite/tests/typecheck/should_fail/T10971b.stderr b/testsuite/tests/typecheck/should_fail/T10971b.stderr index 2e63617464..3ac8c4400b 100644 --- a/testsuite/tests/typecheck/should_fail/T10971b.stderr +++ b/testsuite/tests/typecheck/should_fail/T10971b.stderr @@ -11,7 +11,7 @@ T10971b.hs:4:11: error: instance Foldable Maybe -- Defined in ‘Data.Foldable’ instance Foldable ((,) a) -- Defined in ‘Data.Foldable’ ...plus one other - ...plus 25 instances involving out-of-scope types + ...plus 29 instances involving out-of-scope types (use -fprint-potential-instances to see them all) • In the expression: length x In the expression: \ x -> length x @@ -29,7 +29,7 @@ T10971b.hs:5:13: error: instance Traversable Maybe -- Defined in ‘Data.Traversable’ instance Traversable ((,) a) -- Defined in ‘Data.Traversable’ ...plus one other - ...plus 25 instances involving out-of-scope types + ...plus 29 instances involving out-of-scope types (use -fprint-potential-instances to see them all) • In the expression: fmapDefault f x In the expression: \ f x -> fmapDefault f x @@ -47,7 +47,7 @@ T10971b.hs:6:14: error: instance Traversable Maybe -- Defined in ‘Data.Traversable’ instance Traversable ((,) a) -- Defined in ‘Data.Traversable’ ...plus one other - ...plus 25 instances involving out-of-scope types + ...plus 29 instances involving out-of-scope types (use -fprint-potential-instances to see them all) • In the expression: fmapDefault f x In the expression: (fmapDefault f x, length x) @@ -65,7 +65,7 @@ T10971b.hs:6:31: error: instance Foldable Maybe -- Defined in ‘Data.Foldable’ instance Foldable ((,) a) -- Defined in ‘Data.Foldable’ ...plus one other - ...plus 25 instances involving out-of-scope types + ...plus 29 instances involving out-of-scope types (use -fprint-potential-instances to see them all) • In the expression: length x In the expression: (fmapDefault f x, length x) diff --git a/testsuite/tests/typecheck/should_fail/T11112.stderr b/testsuite/tests/typecheck/should_fail/T11112.stderr index ec2154c8ce..304078158e 100644 --- a/testsuite/tests/typecheck/should_fail/T11112.stderr +++ b/testsuite/tests/typecheck/should_fail/T11112.stderr @@ -1,5 +1,13 @@ T11112.hs:3:9: error: • Expected a type, but ‘Ord s’ has kind ‘Constraint’ - • In the type signature: - sort :: Ord s -> [s] -> [s] + • In the type signature: sort :: Ord s -> [s] -> [s] + +T11112.hs:4:11: error: + • Couldn't match expected type ‘[s] -> [s]’ + with actual type ‘Ord s’ + • In the expression: xs + In an equation for ‘sort’: sort xs = xs + • Relevant bindings include + xs :: Ord s (bound at T11112.hs:4:6) + sort :: Ord s => [s] -> [s] (bound at T11112.hs:4:1) diff --git a/testsuite/tests/typecheck/should_fail/T11313.hs b/testsuite/tests/typecheck/should_fail/T11313.hs index 86ac9582b8..68aa5b0f6c 100644 --- a/testsuite/tests/typecheck/should_fail/T11313.hs +++ b/testsuite/tests/typecheck/should_fail/T11313.hs @@ -2,8 +2,6 @@ module T11313 where -import Data.Kind - x = fmap @ (*) -- test error message output, which was quite silly before diff --git a/testsuite/tests/typecheck/should_fail/T11313.stderr b/testsuite/tests/typecheck/should_fail/T11313.stderr index 7a681d17aa..8697d3b6c7 100644 --- a/testsuite/tests/typecheck/should_fail/T11313.stderr +++ b/testsuite/tests/typecheck/should_fail/T11313.stderr @@ -1,6 +1,6 @@ -T11313.hs:7:12: error: +T11313.hs:5:13: error: • Expected kind ‘* -> *’, but ‘*’ has kind ‘*’ - • In the type ‘*’ - In the expression: fmap @* - In an equation for ‘x’: x = fmap @* + • In the type ‘(*)’ + In the expression: fmap @(*) + In an equation for ‘x’: x = fmap @(*) diff --git a/testsuite/tests/typecheck/should_fail/T11355.stderr b/testsuite/tests/typecheck/should_fail/T11355.stderr index 68375400a8..5310989327 100644 --- a/testsuite/tests/typecheck/should_fail/T11355.stderr +++ b/testsuite/tests/typecheck/should_fail/T11355.stderr @@ -1,6 +1,6 @@ T11355.hs:5:7: error: - • Illegal polymorphic type: forall (a :: TYPE t0). a + • Illegal polymorphic type: forall a. a GHC doesn't yet support impredicative polymorphism • In the expression: const @_ @((forall a. a) -> forall a. a) () (id @(forall a. a)) diff --git a/testsuite/tests/typecheck/should_fail/T11356.stderr b/testsuite/tests/typecheck/should_fail/T11356.stderr index aa1db97c62..e0224022a2 100644 --- a/testsuite/tests/typecheck/should_fail/T11356.stderr +++ b/testsuite/tests/typecheck/should_fail/T11356.stderr @@ -1,5 +1,4 @@ T11356.hs:3:7: error: - • Expecting one fewer arguments to ‘T p’ - Expected kind ‘k0 -> Constraint’, but ‘T p’ has kind ‘Constraint’ + • Expected kind ‘k0 -> Constraint’, but ‘T p’ has kind ‘Constraint’ • In the class declaration for ‘C’ diff --git a/testsuite/tests/typecheck/should_fail/T11563.stderr b/testsuite/tests/typecheck/should_fail/T11563.stderr index 27eca84816..1283c33983 100644 --- a/testsuite/tests/typecheck/should_fail/T11563.stderr +++ b/testsuite/tests/typecheck/should_fail/T11563.stderr @@ -1,4 +1,10 @@ +T11563.hs:5:10: error: + • Variable ‘s’ occurs more often + in the constraint ‘C s’ than in the instance head ‘C T’ + (Use UndecidableInstances to permit this) + • In the instance declaration for ‘C T’ + T11563.hs:5:19: error: • Expecting one more argument to ‘T’ Expected a type, but ‘T’ has kind ‘* -> *’ diff --git a/testsuite/tests/typecheck/should_fail/T11672.hs b/testsuite/tests/typecheck/should_fail/T11672.hs new file mode 100644 index 0000000000..8c5e2fba6e --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T11672.hs @@ -0,0 +1,9 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE KindSignatures #-} +module BadError where + +import GHC.TypeLits +import Data.Proxy + +f :: Proxy (a :: Symbol) -> Int +f _ = f (Proxy :: Proxy (Int -> Bool)) diff --git a/testsuite/tests/typecheck/should_fail/T11672.stderr b/testsuite/tests/typecheck/should_fail/T11672.stderr new file mode 100644 index 0000000000..16eb31042f --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T11672.stderr @@ -0,0 +1,12 @@ + +T11672.hs:9:10: error: + • Couldn't match kind ‘*’ with ‘Symbol’ + When matching types + a0 :: Symbol + Int -> Bool :: * + Expected type: Proxy a0 + Actual type: Proxy (Int -> Bool) + • In the first argument of ‘f’, namely + ‘(Proxy :: Proxy (Int -> Bool))’ + In the expression: f (Proxy :: Proxy (Int -> Bool)) + In an equation for ‘f’: f _ = f (Proxy :: Proxy (Int -> Bool)) diff --git a/testsuite/tests/typecheck/should_fail/T11724.hs b/testsuite/tests/typecheck/should_fail/T11724.hs index df575bd9b5..23412e9df9 100644 --- a/testsuite/tests/typecheck/should_fail/T11724.hs +++ b/testsuite/tests/typecheck/should_fail/T11724.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE TypeInType #-} +{-# LANGUAGE PolyKinds #-} module T11724 where diff --git a/testsuite/tests/typecheck/should_fail/T12042.stderr b/testsuite/tests/typecheck/should_fail/T12042.stderr index e9b139ca57..3266a1fe11 100644 --- a/testsuite/tests/typecheck/should_fail/T12042.stderr +++ b/testsuite/tests/typecheck/should_fail/T12042.stderr @@ -2,8 +2,8 @@ [2 of 3] Compiling T12042a ( T12042a.hs, T12042a.o ) [3 of 3] Compiling T12042 ( T12042.hs, T12042.o ) -T12042.hs:3:1: error: - Cycle in type synonym declarations: - T12042.hs:3:1-12: type S = R - T12042a.hs:3:1-10: B.U from external module - T12042.hs:4:1-12: type R = B.U +T12042.hs-boot:2:1: error: + Type constructor ‘S’ has conflicting definitions in the module + and its hs-boot file + Main module: type S = R + Boot file: data S diff --git a/testsuite/tests/typecheck/should_fail/T12083a.stderr b/testsuite/tests/typecheck/should_fail/T12083a.stderr index dc1452da6f..910d4c35e4 100644 --- a/testsuite/tests/typecheck/should_fail/T12083a.stderr +++ b/testsuite/tests/typecheck/should_fail/T12083a.stderr @@ -7,6 +7,6 @@ T12083a.hs:5:1: error: T12083a.hs:9:26: error: • Data constructor ‘ExistentiallyLost’ has existential type variables, a context, or a specialised result type ExistentiallyLost :: forall u. TC u => u -> ExistentiallyLost - (Use ExistentialQuantification or GADTs to allow this) + (Enable ExistentialQuantification or GADTs to allow this) • In the definition of data constructor ‘ExistentiallyLost’ In the data type declaration for ‘ExistentiallyLost’ diff --git a/testsuite/tests/typecheck/should_fail/T12083b.stderr b/testsuite/tests/typecheck/should_fail/T12083b.stderr index 39ceeced74..ae9d48754c 100644 --- a/testsuite/tests/typecheck/should_fail/T12083b.stderr +++ b/testsuite/tests/typecheck/should_fail/T12083b.stderr @@ -3,5 +3,5 @@ T12083b.hs:6:5: error: • Illegal qualified type: Eq a => r Perhaps you intended to use RankNTypes or Rank2Types • When checking the class method: - test :: forall a. Class a => forall r. a -> (Eq a => r) -> r + test :: forall a r. Class a => a -> (Eq a => r) -> r In the class declaration for ‘Class’ diff --git a/testsuite/tests/typecheck/should_fail/T12151.stderr b/testsuite/tests/typecheck/should_fail/T12151.stderr index 4b233d8b64..8a4831c535 100644 --- a/testsuite/tests/typecheck/should_fail/T12151.stderr +++ b/testsuite/tests/typecheck/should_fail/T12151.stderr @@ -9,7 +9,7 @@ T12151.hs:9:13: error: • Could not deduce (Put a0) from the context: Put a bound by the type signature for: - put :: forall a. Put a => forall t. t + put :: forall a t. Put a => t at T12151.hs:9:13-15 The type variable ‘a0’ is ambiguous • In the ambiguity check for ‘put’ diff --git a/testsuite/tests/typecheck/should_fail/T12177.stderr b/testsuite/tests/typecheck/should_fail/T12177.stderr index ae57decfbc..0c810f4185 100644 --- a/testsuite/tests/typecheck/should_fail/T12177.stderr +++ b/testsuite/tests/typecheck/should_fail/T12177.stderr @@ -2,7 +2,8 @@ T12177.hs:3:19: error: • Found hole: _ :: t Where: ‘t’ is a rigid type variable bound by - the inferred type of bar :: p -> p1 -> t at T12177.hs:3:1-19 + the inferred type of bar :: p -> p1 -> t + at T12177.hs:3:1-19 • In the expression: _ In the expression: \ x -> _ In the expression: \ x -> \ x -> _ diff --git a/testsuite/tests/typecheck/should_fail/T12373.hs b/testsuite/tests/typecheck/should_fail/T12373.hs new file mode 100644 index 0000000000..3f23779b82 --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T12373.hs @@ -0,0 +1,10 @@ +{-# LANGUAGE MagicHash, ScopedTypeVariables, UnboxedTuples #-} + +module T12373 where + +import GHC.MVar +import GHC.Prim +import GHC.Types + +main :: IO () +main = IO (\rw -> newMVar# rw) >> return () diff --git a/testsuite/tests/typecheck/should_fail/T12373.stderr b/testsuite/tests/typecheck/should_fail/T12373.stderr new file mode 100644 index 0000000000..a2568d75f9 --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T12373.stderr @@ -0,0 +1,11 @@ + +T12373.hs:10:19: error: + • Couldn't match a lifted type with an unlifted type + When matching types + a0 :: * + MVar# RealWorld a1 :: TYPE 'UnliftedRep + Expected type: (# State# RealWorld, a0 #) + Actual type: (# State# RealWorld, MVar# RealWorld a1 #) + • In the expression: newMVar# rw + In the first argument of ‘IO’, namely ‘(\ rw -> newMVar# rw)’ + In the first argument of ‘(>>)’, namely ‘IO (\ rw -> newMVar# rw)’ diff --git a/testsuite/tests/typecheck/should_fail/T12406.stderr b/testsuite/tests/typecheck/should_fail/T12406.stderr index 85096e6184..5219a5f290 100644 --- a/testsuite/tests/typecheck/should_fail/T12406.stderr +++ b/testsuite/tests/typecheck/should_fail/T12406.stderr @@ -1,12 +1,3 @@ -T12406.hs:20:7: error: - • Couldn't match type ‘Ref m0’ with ‘IORef’ - Expected type: IO (Ref m0 (f0 ())) - Actual type: IO (Ref IO (f0 ())) - The type variable ‘m0’ is ambiguous - • In the first argument of ‘(>>=)’, namely ‘newRef (pure ())’ - In the expression: newRef (pure ()) >>= join . readRef - In an equation for ‘foo’: foo = newRef (pure ()) >>= join . readRef - T12406.hs:20:28: error: Variable not in scope: join :: m0 (f0 ()) -> IO () diff --git a/testsuite/tests/typecheck/should_fail/T12563.hs b/testsuite/tests/typecheck/should_fail/T12563.hs new file mode 100644 index 0000000000..394fa615d8 --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T12563.hs @@ -0,0 +1,7 @@ +{-# LANGUAGE RankNTypes #-} +module T12563 where + +foo :: ((forall a. f a) -> f r) -> f r +foo g = undefined + +x = \g -> foo g diff --git a/testsuite/tests/typecheck/should_fail/T12563.stderr b/testsuite/tests/typecheck/should_fail/T12563.stderr new file mode 100644 index 0000000000..f32e99d1f0 --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T12563.stderr @@ -0,0 +1,11 @@ + +T12563.hs:7:15: error: + • Cannot instantiate unification variable ‘p0’ + with a type involving foralls: (forall a. f0 a) -> f0 r0 + GHC doesn't yet support impredicative polymorphism + • In the first argument of ‘foo’, namely ‘g’ + In the expression: foo g + In the expression: \ g -> foo g + • Relevant bindings include + g :: p0 (bound at T12563.hs:7:6) + x :: p0 -> f0 r0 (bound at T12563.hs:7:1) diff --git a/testsuite/tests/typecheck/should_fail/T12589.stderr b/testsuite/tests/typecheck/should_fail/T12589.stderr index f77d6457b9..5e92f3af86 100644 --- a/testsuite/tests/typecheck/should_fail/T12589.stderr +++ b/testsuite/tests/typecheck/should_fail/T12589.stderr @@ -1,8 +1,8 @@ -T12589.hs:13:3: error: Variable not in scope: (&) :: t0 -> t1 -> t +T12589.hs:13:3: error: Variable not in scope: (&) :: t1 -> t0 -> t T12589.hs:13:5: error: - • Cannot instantiate unification variable ‘t1’ + • Cannot instantiate unification variable ‘t0’ with a type involving foralls: (forall a. Bounded a => f0 a) -> h0 f0 xs0 GHC doesn't yet support impredicative polymorphism diff --git a/testsuite/tests/typecheck/should_fail/T12648.hs b/testsuite/tests/typecheck/should_fail/T12648.hs index b36ecce3bc..b75bcf9226 100644 --- a/testsuite/tests/typecheck/should_fail/T12648.hs +++ b/testsuite/tests/typecheck/should_fail/T12648.hs @@ -13,7 +13,7 @@ {-# LANGUAGE UndecidableSuperClasses #-} module T12648 where -import GHC.Exts (Constraint) +import Data.Kind (Type, Constraint) import Unsafe.Coerce (unsafeCoerce) type family Skolem (p :: k -> Constraint) :: k @@ -25,7 +25,7 @@ instance p (Skolem p) => Forall_ (p :: k -> Constraint) inst :: forall p a. Forall p :- p a inst = unsafeCoerce (Sub Dict :: Forall p :- p (Skolem p)) -data Dict :: Constraint -> * where +data Dict :: Constraint -> Type where Dict :: a => Dict a newtype a :- b = Sub (a => Dict b) @@ -40,7 +40,7 @@ class (Applicative b, Applicative m, Monad b, Monad m) => MonadBase b m | m -> b instance MonadBase IO IO -- where liftBase = id class MonadBase b m => MonadBaseControl b m | m -> b where - type StM m a :: * + type StM m a :: Type liftBaseWith :: (RunInBase m b -> b a) -> m a type RunInBase m b = forall a. m a -> b (StM m a) diff --git a/testsuite/tests/typecheck/should_fail/T12709.hs b/testsuite/tests/typecheck/should_fail/T12709.hs index 2bbcf744d0..6a7e37a5d2 100644 --- a/testsuite/tests/typecheck/should_fail/T12709.hs +++ b/testsuite/tests/typecheck/should_fail/T12709.hs @@ -1,4 +1,5 @@ -{-# Language MagicHash, PolyKinds, ViewPatterns, TypeInType, RebindableSyntax, NoImplicitPrelude #-} +{-# Language PolyKinds, ViewPatterns, RebindableSyntax, + MagicHash, NoImplicitPrelude #-} module T12709 where diff --git a/testsuite/tests/typecheck/should_fail/T12709.stderr b/testsuite/tests/typecheck/should_fail/T12709.stderr index 7be861c061..9d79d8dd0c 100644 --- a/testsuite/tests/typecheck/should_fail/T12709.stderr +++ b/testsuite/tests/typecheck/should_fail/T12709.stderr @@ -1,23 +1,23 @@ -T12709.hs:27:13: error: +T12709.hs:28:13: error: A levity-polymorphic type is not allowed here: Type: a Kind: TYPE rep In the type of expression: 1 -T12709.hs:27:17: error: +T12709.hs:28:17: error: A levity-polymorphic type is not allowed here: Type: a Kind: TYPE rep In the type of expression: 2 -T12709.hs:27:21: error: +T12709.hs:28:21: error: A levity-polymorphic type is not allowed here: Type: a Kind: TYPE rep In the type of expression: 3 -T12709.hs:27:25: error: +T12709.hs:28:25: error: A levity-polymorphic type is not allowed here: Type: a Kind: TYPE rep diff --git a/testsuite/tests/typecheck/should_fail/T12785b.hs b/testsuite/tests/typecheck/should_fail/T12785b.hs index 4188e3e67c..b827372bf0 100644 --- a/testsuite/tests/typecheck/should_fail/T12785b.hs +++ b/testsuite/tests/typecheck/should_fail/T12785b.hs @@ -1,6 +1,6 @@ -{-# LANGUAGE RankNTypes, TypeInType, TypeOperators, KindSignatures, ViewPatterns #-} +{-# LANGUAGE RankNTypes, TypeOperators, ViewPatterns #-} {-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE DataKinds, GADTs #-} +{-# LANGUAGE DataKinds, PolyKinds, GADTs #-} module T12785b where @@ -13,14 +13,14 @@ data HTree n a where Leaf :: HTree (S n) a Branch :: a -> HTree n (HTree (S n) a) -> HTree (S n) a -data STree n :: forall a . (a -> *) -> HTree n a -> * where +data STree n :: forall a . (a -> Type) -> HTree n a -> Type where SPoint :: f a -> STree Z f (Point a) SLeaf :: STree (S n) f Leaf SBranch :: f a -> STree n (STree (S n) f) stru -> STree (S n) f (a `Branch` stru) SBranchX :: (Payload (S n) (Payload n stru) ~ a) => f a -> STree n (STree (S n) f) stru -> STree (S n) f (a `Branch` stru) -data Hidden :: Peano -> (a -> *) -> * where +data Hidden :: Peano -> (a -> Type) -> Type where Hide :: STree n f s -> Hidden n f nest :: HTree m (Hidden (S m) f) -> Hidden m (STree ('S m) f) diff --git a/testsuite/tests/typecheck/should_fail/T12785b.stderr b/testsuite/tests/typecheck/should_fail/T12785b.stderr index 1b1d1bc569..44937c3c45 100644 --- a/testsuite/tests/typecheck/should_fail/T12785b.stderr +++ b/testsuite/tests/typecheck/should_fail/T12785b.stderr @@ -8,18 +8,20 @@ T12785b.hs:29:63: error: a -> HTree n (HTree ('S n) a) -> HTree ('S n) a, in an equation for ‘nest’ at T12785b.hs:29:7-51 + ‘s’ is a rigid type variable bound by + a pattern with constructor: + Hide :: forall a (n :: Peano) (f :: a -> *) (s :: HTree n a). + STree n f s -> Hidden n f, + in an equation for ‘nest’ + at T12785b.hs:29:7-12 • In the second argument of ‘($)’, namely ‘a `SBranchX` tr’ In the expression: Hide $ a `SBranchX` tr In an equation for ‘nest’: nest (Hide a `Branch` (nest . hmap nest -> Hide tr)) = Hide $ a `SBranchX` tr • Relevant bindings include - tr :: STree - n - (HTree ('S n) (HTree ('S ('S n)) a)) - (STree ('S n) (HTree ('S ('S n)) a) (STree ('S ('S n)) a f)) - s1 + tr :: STree n (STree ('S n) (STree ('S ('S n)) f)) s1 (bound at T12785b.hs:29:49) - a :: STree ('S m) a f s (bound at T12785b.hs:29:12) - nest :: HTree m (Hidden ('S m) f) -> Hidden m (STree ('S m) a f) + a :: STree ('S m) f s (bound at T12785b.hs:29:12) + nest :: HTree m (Hidden ('S m) f) -> Hidden m (STree ('S m) f) (bound at T12785b.hs:27:1) diff --git a/testsuite/tests/typecheck/should_fail/T12837.stderr b/testsuite/tests/typecheck/should_fail/T12837.stderr index 893575f08c..bf2e89b72a 100644 --- a/testsuite/tests/typecheck/should_fail/T12837.stderr +++ b/testsuite/tests/typecheck/should_fail/T12837.stderr @@ -1,12 +1,12 @@ -T12837.hs:10:1: error: +T12837.hs:10:10: error: • Class ‘Typeable’ does not support user-specified instances • In the instance declaration for ‘Typeable K’ - -T12837.hs:11:1: error: + +T12837.hs:11:10: error: • Class ‘KnownNat’ does not support user-specified instances • In the instance declaration for ‘KnownNat n’ -T12837.hs:12:1: error: +T12837.hs:12:10: error: • Class ‘KnownSymbol’ does not support user-specified instances • In the instance declaration for ‘KnownSymbol n’ diff --git a/testsuite/tests/typecheck/should_fail/T12918b.stderr b/testsuite/tests/typecheck/should_fail/T12918b.stderr index 92aa85e9f3..3492ca6415 100644 --- a/testsuite/tests/typecheck/should_fail/T12918b.stderr +++ b/testsuite/tests/typecheck/should_fail/T12918b.stderr @@ -3,34 +3,34 @@ T12918b.hs:8:11: error: • The default type signature for bar1: forall b. b -> a does not match its corresponding non-default type signature • When checking the class method: - bar1 :: forall a. Foo1 a => forall b. a -> b + bar1 :: forall a b. Foo1 a => a -> b In the class declaration for ‘Foo1’ T12918b.hs:12:11: error: • The default type signature for bar2: forall x. x does not match its corresponding non-default type signature • When checking the class method: - bar2 :: forall a. Foo1 a => forall b. a -> b + bar2 :: forall a b. Foo1 a => a -> b In the class declaration for ‘Foo1’ T12918b.hs:12:11: error: • Could not deduce (Foo1 a0) from the context: Foo1 a bound by the type signature for: - bar2 :: forall a. Foo1 a => forall x. x + bar2 :: forall a x. Foo1 a => x at T12918b.hs:12:11-14 The type variable ‘a0’ is ambiguous • In the ambiguity check for ‘bar2’ To defer the ambiguity check to use sites, enable AllowAmbiguousTypes When checking the class method: - bar2 :: forall a. Foo1 a => forall b. a -> b + bar2 :: forall a b. Foo1 a => a -> b In the class declaration for ‘Foo1’ T12918b.hs:16:11: error: • The default type signature for bar3: a -> Int does not match its corresponding non-default type signature • When checking the class method: - bar3 :: forall a. Foo1 a => forall b. a -> b + bar3 :: forall a b. Foo1 a => a -> b In the class declaration for ‘Foo1’ T12918b.hs:20:11: error: diff --git a/testsuite/tests/typecheck/should_fail/T12921.stderr b/testsuite/tests/typecheck/should_fail/T12921.stderr index bd0ba8e43d..d38ccf22b9 100644 --- a/testsuite/tests/typecheck/should_fail/T12921.stderr +++ b/testsuite/tests/typecheck/should_fail/T12921.stderr @@ -10,7 +10,7 @@ T12921.hs:4:1: error: instance Data.Data.Data Ordering -- Defined in ‘Data.Data’ instance Data.Data.Data Integer -- Defined in ‘Data.Data’ ...plus 15 others - ...plus 42 instances involving out-of-scope types + ...plus 47 instances involving out-of-scope types (use -fprint-potential-instances to see them all) • In the annotation: {-# ANN module "HLint: ignore Reduce duplication" #-} diff --git a/testsuite/tests/typecheck/should_fail/T12973.hs b/testsuite/tests/typecheck/should_fail/T12973.hs index 624d24be24..b0a33a8213 100644 --- a/testsuite/tests/typecheck/should_fail/T12973.hs +++ b/testsuite/tests/typecheck/should_fail/T12973.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE RebindableSyntax, TypeInType, ExplicitForAll #-} +{-# LANGUAGE RebindableSyntax, PolyKinds, ExplicitForAll #-} module T12973 where diff --git a/testsuite/tests/typecheck/should_fail/T13068.stderr b/testsuite/tests/typecheck/should_fail/T13068.stderr index c161209001..6ecf1871c6 100644 --- a/testsuite/tests/typecheck/should_fail/T13068.stderr +++ b/testsuite/tests/typecheck/should_fail/T13068.stderr @@ -1,6 +1,6 @@ [1 of 4] Compiling T13068[boot] ( T13068.hs-boot, T13068.o-boot ) [2 of 4] Compiling T13068a ( T13068a.hs, T13068a.o ) -T13068a.hs:3:1: error: +T13068a.hs:3:10: error: • Cannot define instance for abstract class ‘C’ • In the instance declaration for ‘C Int’ diff --git a/testsuite/tests/typecheck/should_fail/T13075.stderr b/testsuite/tests/typecheck/should_fail/T13075.stderr new file mode 100644 index 0000000000..89abb9afe3 --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T13075.stderr @@ -0,0 +1,3 @@ + +T13075.hs:5:1: error: + Top-level strict bindings aren't allowed: !(Just x) = Nothing diff --git a/testsuite/tests/typecheck/should_fail/T13105.hs b/testsuite/tests/typecheck/should_fail/T13105.hs index 44384dc19d..b2b23c7442 100644 --- a/testsuite/tests/typecheck/should_fail/T13105.hs +++ b/testsuite/tests/typecheck/should_fail/T13105.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE UnicodeSyntax, MagicHash, TypeInType, TypeFamilies #-} +{-# LANGUAGE UnicodeSyntax, MagicHash, DataKinds, PolyKinds, TypeFamilies #-} -- from Conal Elliott -- Actually, this *should* work. But I want to put it in the testsuite diff --git a/testsuite/tests/typecheck/should_fail/T13292.stderr b/testsuite/tests/typecheck/should_fail/T13292.stderr index 5d8ccd117f..9f70b1df27 100644 --- a/testsuite/tests/typecheck/should_fail/T13292.stderr +++ b/testsuite/tests/typecheck/should_fail/T13292.stderr @@ -10,7 +10,7 @@ T13292a.hs:4:12: warning: [-Wdeferred-type-errors (in -Wdefault)] instance Monad Maybe -- Defined in ‘GHC.Base’ instance Monoid a => Monad ((,) a) -- Defined in ‘GHC.Base’ ...plus one other - ...plus one instance involving out-of-scope types + ...plus two instances involving out-of-scope types (use -fprint-potential-instances to see them all) • In the expression: return () In an equation for ‘someFunc’: someFunc = return () diff --git a/testsuite/tests/typecheck/should_fail/T13311.stderr b/testsuite/tests/typecheck/should_fail/T13311.stderr index 923f3789ef..d739d2173c 100644 --- a/testsuite/tests/typecheck/should_fail/T13311.stderr +++ b/testsuite/tests/typecheck/should_fail/T13311.stderr @@ -1,7 +1,7 @@ T13311.hs:9:3: error: - • Couldn't match expected type ‘IO a1’ - with actual type ‘Maybe a0 -> Maybe b0’ + • Couldn't match expected type ‘IO a0’ + with actual type ‘Maybe a1 -> Maybe b0’ • Probable cause: ‘f’ is applied to too few arguments In a stmt of a 'do' block: f In the expression: diff --git a/testsuite/tests/typecheck/should_fail/T13446.hs b/testsuite/tests/typecheck/should_fail/T13446.hs index 11a60776f6..b5bd77fcb0 100644 --- a/testsuite/tests/typecheck/should_fail/T13446.hs +++ b/testsuite/tests/typecheck/should_fail/T13446.hs @@ -11,10 +11,10 @@ module T13446 where import Data.Coerce (Coercible) -import GHC.Exts (Constraint) +import Data.Kind (Type, Constraint) import GHC.TypeLits (Symbol) -data Dict :: Constraint -> * where +data Dict :: Constraint -> Type where Dict :: a => Dict a infixr 9 :- diff --git a/testsuite/tests/typecheck/should_fail/T13530.hs b/testsuite/tests/typecheck/should_fail/T13530.hs new file mode 100644 index 0000000000..9f95e497f2 --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T13530.hs @@ -0,0 +1,11 @@ +{-# LANGUAGE MagicHash, UnboxedTuples #-} + +module T13530 where + +import GHC.Exts + +g :: Int -> (# Int#, a #) +g (I# y) = (# y, undefined #) + +f :: Int -> (# Int#, Int# #) +f x = g x diff --git a/testsuite/tests/typecheck/should_fail/T13530.stderr b/testsuite/tests/typecheck/should_fail/T13530.stderr new file mode 100644 index 0000000000..139c1b0f34 --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T13530.stderr @@ -0,0 +1,10 @@ + +T13530.hs:11:7: error: + • Couldn't match a lifted type with an unlifted type + When matching types + a0 :: * + Int# :: TYPE 'IntRep + Expected type: (# Int#, Int# #) + Actual type: (# Int#, a0 #) + • In the expression: g x + In an equation for ‘f’: f x = g x diff --git a/testsuite/tests/typecheck/should_fail/T13610.hs b/testsuite/tests/typecheck/should_fail/T13610.hs new file mode 100644 index 0000000000..371c3388e9 --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T13610.hs @@ -0,0 +1,11 @@ +{-# LANGUAGE MagicHash #-} + +module T13610 where + +import GHC.Prim +import GHC.Types + +main = do + let primDouble = 0.42## :: Double# + let double = 0.42 :: Double + IO (\s -> mkWeakNoFinalizer# double () s) diff --git a/testsuite/tests/typecheck/should_fail/T13610.stderr b/testsuite/tests/typecheck/should_fail/T13610.stderr new file mode 100644 index 0000000000..0755ce9371 --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T13610.stderr @@ -0,0 +1,14 @@ + +T13610.hs:11:15: error: + • Couldn't match a lifted type with an unlifted type + When matching types + a :: * + Weak# () :: TYPE 'UnliftedRep + Expected type: (# State# RealWorld, a #) + Actual type: (# State# RealWorld, Weak# () #) + • In the expression: mkWeakNoFinalizer# double () s + In the first argument of ‘IO’, namely + ‘(\ s -> mkWeakNoFinalizer# double () s)’ + In a stmt of a 'do' block: + IO (\ s -> mkWeakNoFinalizer# double () s) + • Relevant bindings include main :: IO a (bound at T13610.hs:8:1) diff --git a/testsuite/tests/typecheck/should_fail/T13819.hs b/testsuite/tests/typecheck/should_fail/T13819.hs new file mode 100644 index 0000000000..5244ddc840 --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T13819.hs @@ -0,0 +1,14 @@ +{-# LANGUAGE DeriveFunctor, TypeApplications #-} + +module T13819 where + +import Data.Coerce +import Control.Applicative + +newtype A a = A (IO a) + deriving Functor + +instance Applicative A where + pure = pure @(_ -> WrappedMonad A _) @(_ -> A _) pure + +instance Monad A where diff --git a/testsuite/tests/typecheck/should_fail/T13819.stderr b/testsuite/tests/typecheck/should_fail/T13819.stderr new file mode 100644 index 0000000000..ab818f399b --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T13819.stderr @@ -0,0 +1,18 @@ + +T13819.hs:12:10: error: + • Couldn't match type ‘w0 -> A w0’ with ‘A a’ + Expected type: a -> A a + Actual type: (w1 -> WrappedMonad A w2) (w0 -> A w0) + • In the expression: pure @(_ -> WrappedMonad A _) @(_ -> A _) pure + In an equation for ‘pure’: + pure = pure @(_ -> WrappedMonad A _) @(_ -> A _) pure + In the instance declaration for ‘Applicative A’ + • Relevant bindings include + pure :: a -> A a (bound at T13819.hs:12:3) + +T13819.hs:12:17: error: + • Expected kind ‘* -> *’, but ‘_ -> WrappedMonad A _’ has kind ‘*’ + • In the type ‘(_ -> WrappedMonad A _)’ + In the expression: pure @(_ -> WrappedMonad A _) @(_ -> A _) pure + In an equation for ‘pure’: + pure = pure @(_ -> WrappedMonad A _) @(_ -> A _) pure diff --git a/testsuite/tests/typecheck/should_fail/T13902.hs b/testsuite/tests/typecheck/should_fail/T13902.hs new file mode 100644 index 0000000000..73f34f2f66 --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T13902.hs @@ -0,0 +1,8 @@ +{-# LANGUAGE TypeApplications #-} +module T13902 where + +f :: a -> a +f x = x + +g :: Int +g = f @Int 42 5 diff --git a/testsuite/tests/typecheck/should_fail/T13902.stderr b/testsuite/tests/typecheck/should_fail/T13902.stderr new file mode 100644 index 0000000000..c3d07edfd1 --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T13902.stderr @@ -0,0 +1,8 @@ + +T13902.hs:8:5: error: + • Couldn't match expected type ‘Integer -> Int’ + with actual type ‘Int’ + • The expression ‘f @Int’ is applied to two arguments, + but its type ‘Int -> Int’ has only one + In the expression: f @Int 42 5 + In an equation for ‘g’: g = f @Int 42 5 diff --git a/testsuite/tests/typecheck/should_fail/T13909.hs b/testsuite/tests/typecheck/should_fail/T13909.hs new file mode 100644 index 0000000000..58798d5f79 --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T13909.hs @@ -0,0 +1,12 @@ +{-# LANGUAGE PolyKinds #-} +module T13909 where + +import Data.Kind + +data Hm (k :: Type) (a :: k) :: Type + +class HasName (a :: k) where + getName :: proxy a -> String + +instance HasName Hm where + getName _ = "Hm" diff --git a/testsuite/tests/typecheck/should_fail/T13909.stderr b/testsuite/tests/typecheck/should_fail/T13909.stderr new file mode 100644 index 0000000000..d70221c3fd --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T13909.stderr @@ -0,0 +1,11 @@ + +T13909.hs:11:10: error: + • Illegal type synonym family application ‘GHC.Types.Any’ in instance: + HasName Hm + Use -fprint-explicit-kinds to see the kind arguments + • In the instance declaration for ‘HasName Hm’ + +T13909.hs:11:18: error: + • Expected kind ‘k0’, but ‘Hm’ has kind ‘forall k -> k -> *’ + • In the first argument of ‘HasName’, namely ‘Hm’ + In the instance declaration for ‘HasName Hm’ diff --git a/testsuite/tests/typecheck/should_fail/T13929.hs b/testsuite/tests/typecheck/should_fail/T13929.hs new file mode 100644 index 0000000000..f0801e8e0e --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T13929.hs @@ -0,0 +1,37 @@ +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DefaultSignatures #-} +{-# LANGUAGE UnboxedTuples #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE AllowAmbiguousTypes #-} + +module Main where + +import GHC.Exts +import Data.Kind +import GHC.Generics + +class GUnbox (f :: Type -> Type) (r :: RuntimeRep) where + type GUnboxed f r :: TYPE r + gunbox :: f p -> GUnboxed f r + +instance (GUnbox f rf, GUnbox g rg) => GUnbox (f :*: g) ('TupleRep '[rf, rg]) where + type GUnboxed (f :*: g) ('TupleRep '[rf, rg]) = (# GUnboxed f rf, GUnboxed g rg #) + -- if I remove implementation of `gunbox` it compiles successfully + gunbox (x :*: y) = (# gunbox x, gunbox y #) + +instance (GUnbox f rf, GUnbox g rg) => GUnbox (f :+: g) ('SumRep '[rf, rg]) where + type GUnboxed (f :+: g) ('SumRep '[rf, rg]) = (# GUnboxed f rf | GUnboxed g rg #) + gunbox (L1 l) = (# gunbox l | #) + gunbox (R1 r) = (# | gunbox r #) + +main :: IO () +main = pure () diff --git a/testsuite/tests/typecheck/should_fail/T13929.stderr b/testsuite/tests/typecheck/should_fail/T13929.stderr new file mode 100644 index 0000000000..d1e1f63dd9 --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T13929.stderr @@ -0,0 +1,24 @@ + +T13929.hs:29:27: error: + A levity-polymorphic type is not allowed here: + Type: GUnboxed f rf + Kind: TYPE rf + In the type of expression: gunbox x + +T13929.hs:29:37: error: + A levity-polymorphic type is not allowed here: + Type: GUnboxed g rg + Kind: TYPE rg + In the type of expression: gunbox y + +T13929.hs:33:24: + A levity-polymorphic type is not allowed here: + Type: GUnboxed f rf + Kind: TYPE rf + In the type of expression: gunbox l + +T13929.hs:34:26: + A levity-polymorphic type is not allowed here: + Type: GUnboxed g rg + Kind: TYPE rg + In the type of expression: gunbox r diff --git a/testsuite/tests/typecheck/should_fail/T13983.stderr b/testsuite/tests/typecheck/should_fail/T13983.stderr index 65ce607961..5c7a031654 100644 --- a/testsuite/tests/typecheck/should_fail/T13983.stderr +++ b/testsuite/tests/typecheck/should_fail/T13983.stderr @@ -3,6 +3,6 @@ T13983.hs:7:1: error: • Kind variable ‘k’ is implicitly bound in type synonym ‘Wat’, but does not appear as the kind of any of its type variables. Perhaps you meant - to bind it (with TypeInType) explicitly somewhere? + to bind it explicitly somewhere? Type variables with inferred kinds: (k :: *) • In the type declaration for ‘Wat’ diff --git a/testsuite/tests/typecheck/should_fail/T14000.hs b/testsuite/tests/typecheck/should_fail/T14000.hs new file mode 100644 index 0000000000..854a78b6ad --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T14000.hs @@ -0,0 +1,8 @@ +{-# LANGUAGE TypeFamilies #-} +module T14000 where + +class C a where + type T a + c :: a -> T a + +foo = c noSuchThing -- noSuchThing is not in scope diff --git a/testsuite/tests/typecheck/should_fail/T14000.stderr b/testsuite/tests/typecheck/should_fail/T14000.stderr new file mode 100644 index 0000000000..8b51e37641 --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T14000.stderr @@ -0,0 +1,2 @@ + +T14000.hs:8:9: error: Variable not in scope: noSuchThing diff --git a/testsuite/tests/typecheck/should_fail/T14048a.hs b/testsuite/tests/typecheck/should_fail/T14048a.hs new file mode 100644 index 0000000000..c717127df8 --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T14048a.hs @@ -0,0 +1,6 @@ +{-# LANGUAGE ConstraintKinds #-} +module T14048a where + +import Data.Kind + +data Foo :: Constraint diff --git a/testsuite/tests/typecheck/should_fail/T14048a.stderr b/testsuite/tests/typecheck/should_fail/T14048a.stderr new file mode 100644 index 0000000000..48a91c7525 --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T14048a.stderr @@ -0,0 +1,5 @@ + +T14048a.hs:6:1: error: + • Kind signature on data type declaration has non-* return kind + Constraint + • In the data declaration for ‘Foo’ diff --git a/testsuite/tests/typecheck/should_fail/T14048b.hs b/testsuite/tests/typecheck/should_fail/T14048b.hs new file mode 100644 index 0000000000..d2f6f74583 --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T14048b.hs @@ -0,0 +1,7 @@ +{-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE TypeFamilies #-} +module T14048b where + +import Data.Kind + +data family Foo :: Constraint diff --git a/testsuite/tests/typecheck/should_fail/T14048b.stderr b/testsuite/tests/typecheck/should_fail/T14048b.stderr new file mode 100644 index 0000000000..fe78d9f7f5 --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T14048b.stderr @@ -0,0 +1,6 @@ + +T14048b.hs:7:1: error: + • Kind signature on data type declaration has non-* + and non-variable return kind + Constraint + • In the data family declaration for ‘Foo’ diff --git a/testsuite/tests/typecheck/should_fail/T14048c.hs b/testsuite/tests/typecheck/should_fail/T14048c.hs new file mode 100644 index 0000000000..e81e454d31 --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T14048c.hs @@ -0,0 +1,9 @@ +{-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE TypeFamilies #-} +module T14048c where + +import Data.Kind + +data family Foo :: k +data instance Foo :: Constraint diff --git a/testsuite/tests/typecheck/should_fail/T14048c.stderr b/testsuite/tests/typecheck/should_fail/T14048c.stderr new file mode 100644 index 0000000000..7e83d1924c --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T14048c.stderr @@ -0,0 +1,5 @@ + +T14048c.hs:9:1: error: + • Kind signature on data type declaration has non-* return kind + Constraint + • In the data instance declaration for ‘Foo’ diff --git a/testsuite/tests/typecheck/should_fail/T14055.hs b/testsuite/tests/typecheck/should_fail/T14055.hs new file mode 100644 index 0000000000..996c33be1c --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T14055.hs @@ -0,0 +1,6 @@ +{-# LANGUAGE DataKinds, TypeFamilies #-} + +newtype X = RollX (() -> X) + +type family F t :: X where + F t = RollX (t -> ()) diff --git a/testsuite/tests/typecheck/should_fail/T14055.stderr b/testsuite/tests/typecheck/should_fail/T14055.stderr new file mode 100644 index 0000000000..19e4d59112 --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T14055.stderr @@ -0,0 +1,6 @@ + +T14055.hs:6:18: error: + • Expected kind ‘() -> X’, but ‘t -> ()’ has kind ‘*’ + • In the first argument of ‘RollX’, namely ‘(t -> ())’ + In the type ‘RollX (t -> ())’ + In the type family declaration for ‘F’ diff --git a/testsuite/tests/typecheck/should_fail/T14232.hs b/testsuite/tests/typecheck/should_fail/T14232.hs new file mode 100644 index 0000000000..79da2cc7b5 --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T14232.hs @@ -0,0 +1,4 @@ +module T14232 where + +f :: (String -> a) String -> a +f g s = g s diff --git a/testsuite/tests/typecheck/should_fail/T14232.stderr b/testsuite/tests/typecheck/should_fail/T14232.stderr new file mode 100644 index 0000000000..1ca41f0bd5 --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T14232.stderr @@ -0,0 +1,17 @@ + +T14232.hs:3:6: error: + • Expected kind ‘* -> *’, but ‘String -> a’ has kind ‘*’ + • In the type signature: f :: (String -> a) String -> a + +T14232.hs:4:9: error: + • Couldn't match type ‘String -> a’ with ‘(->) t0’ + Expected type: t0 -> [Char] + Actual type: (String -> a) String + • The function ‘g’ is applied to one argument, + but its type ‘(String -> a) String’ has none + In the expression: g s + In an equation for ‘f’: f g s = g s + • Relevant bindings include + s :: t0 (bound at T14232.hs:4:5) + g :: (String -> a) String (bound at T14232.hs:4:3) + f :: (String -> a) String -> a (bound at T14232.hs:4:1) diff --git a/testsuite/tests/typecheck/should_fail/T14325.hs b/testsuite/tests/typecheck/should_fail/T14325.hs new file mode 100644 index 0000000000..edb6038165 --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T14325.hs @@ -0,0 +1,11 @@ +{-# LANGUAGE GADTs, MultiParamTypeClasses #-} + +module T14325 where + +class (a~b) => C a b + +foo :: C a b => a -> b +foo x = x + +hm3 :: C (f b) b => b -> f b +hm3 x = foo x diff --git a/testsuite/tests/typecheck/should_fail/T14325.stderr b/testsuite/tests/typecheck/should_fail/T14325.stderr new file mode 100644 index 0000000000..1508c4a689 --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T14325.stderr @@ -0,0 +1,9 @@ + +T14325.hs:11:9: error: + • Could not deduce (C b (f b)) arising from a use of ‘foo’ + from the context: C (f b) b + bound by the type signature for: + hm3 :: forall (f :: * -> *) b. C (f b) b => b -> f b + at T14325.hs:10:1-28 + • In the expression: foo x + In an equation for ‘hm3’: hm3 x = foo x diff --git a/testsuite/tests/typecheck/should_fail/T14350.hs b/testsuite/tests/typecheck/should_fail/T14350.hs new file mode 100644 index 0000000000..9d96e4570e --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T14350.hs @@ -0,0 +1,59 @@ +{-# LANGUAGE AllowAmbiguousTypes #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE PolyKinds, DataKinds #-} +{-# LANGUAGE TypeOperators #-} +module T14350 where + +import Data.Kind + +data Proxy a = Proxy +data family Sing (a :: k) + +data SomeSing k where + SomeSing :: Sing (a :: k) -> SomeSing k + +class SingKind k where + type Demote k :: Type + fromSing :: Sing (a :: k) -> Demote k + toSing :: Demote k -> SomeSing k + +data instance Sing (x :: Proxy k) where + SProxy :: Sing 'Proxy + +instance SingKind (Proxy k) where + type Demote (Proxy k) = Proxy k + fromSing SProxy = Proxy + toSing Proxy = SomeSing SProxy + +data TyFun :: Type -> Type -> Type +type a ~> b = TyFun a b -> Type +infixr 0 ~> + +type family Apply (f :: k1 ~> k2) (x :: k1) :: k2 +type a @@ b = Apply a b +infixl 9 @@ + +newtype instance Sing (f :: k1 ~> k2) = + SLambda { applySing :: forall t. Sing t -> Sing (f @@ t) } + +instance (SingKind k1, SingKind k2) => SingKind (k1 ~> k2) where + type Demote (k1 ~> k2) = Demote k1 -> Demote k2 + fromSing sFun x = case toSing x of SomeSing y -> fromSing (applySing sFun y) + toSing = undefined + +dcomp :: forall (a :: Type) + (b :: a ~> Type) + (c :: forall (x :: a). Proxy x ~> b @@ x ~> Type) + (f :: forall (x :: a) (y :: b @@ x). Proxy x ~> Proxy y ~> c @@ ('Proxy :: Proxy x) @@ y) + (g :: forall (x :: a). Proxy x ~> b @@ x) + (x :: a). + Sing f + -> Sing g + -> Sing x + -> c @@ ('Proxy :: Proxy x) @@ (g @@ ('Proxy :: Proxy x)) +dcomp f g x = applySing f Proxy Proxy diff --git a/testsuite/tests/typecheck/should_fail/T14350.stderr b/testsuite/tests/typecheck/should_fail/T14350.stderr new file mode 100644 index 0000000000..cbf67b405f --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T14350.stderr @@ -0,0 +1,30 @@ + +T14350.hs:59:15: error: + • Couldn't match expected type ‘Proxy a2 + -> Apply (Apply c 'Proxy) (Apply g 'Proxy)’ + with actual type ‘Sing (f @@ t0)’ + • The function ‘applySing’ is applied to three arguments, + but its type ‘Sing f -> Sing t0 -> Sing (f @@ t0)’ has only two + In the expression: applySing f Proxy Proxy + In an equation for ‘dcomp’: dcomp f g x = applySing f Proxy Proxy + • Relevant bindings include + x :: Sing x3 (bound at T14350.hs:59:11) + g :: Sing g (bound at T14350.hs:59:9) + f :: Sing f (bound at T14350.hs:59:7) + dcomp :: Sing f + -> Sing g -> Sing x3 -> (c @@ 'Proxy) @@ (g @@ 'Proxy) + (bound at T14350.hs:59:1) + +T14350.hs:59:27: error: + • Couldn't match expected type ‘Sing t0’ + with actual type ‘Proxy a0’ + • In the second argument of ‘applySing’, namely ‘Proxy’ + In the expression: applySing f Proxy Proxy + In an equation for ‘dcomp’: dcomp f g x = applySing f Proxy Proxy + • Relevant bindings include + x :: Sing x3 (bound at T14350.hs:59:11) + g :: Sing g (bound at T14350.hs:59:9) + f :: Sing f (bound at T14350.hs:59:7) + dcomp :: Sing f + -> Sing g -> Sing x3 -> (c @@ 'Proxy) @@ (g @@ 'Proxy) + (bound at T14350.hs:59:1) diff --git a/testsuite/tests/typecheck/should_fail/T14390.hs b/testsuite/tests/typecheck/should_fail/T14390.hs new file mode 100644 index 0000000000..5360be714c --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T14390.hs @@ -0,0 +1,4 @@ +module T14390 where + +import Data.Type.Equality +instance (~~) Int Int diff --git a/testsuite/tests/typecheck/should_fail/T14390.stderr b/testsuite/tests/typecheck/should_fail/T14390.stderr new file mode 100644 index 0000000000..5604de5177 --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T14390.stderr @@ -0,0 +1,4 @@ + +T14390.hs:4:10: error: + • Class ‘~~’ does not support user-specified instances + • In the instance declaration for ‘(~~) Int Int’ diff --git a/testsuite/tests/typecheck/should_fail/T14605.hs b/testsuite/tests/typecheck/should_fail/T14605.hs new file mode 100644 index 0000000000..4f75d59ebd --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T14605.hs @@ -0,0 +1,14 @@ +{-# Language TypeApplications #-} +{-# Language ImpredicativeTypes #-} +-- This isn't a test for impredicative types; it's +-- just that visible type application on a for-all type +-- is an easy way to provoke the error. +-- +-- The ticket #14605 has a much longer example that +-- also fails; it does not use ImpredicativeTypes + +module T14605 where + +import GHC.Prim (coerce) + +duplicate = coerce @(forall x. ()) @(forall x. x) diff --git a/testsuite/tests/typecheck/should_fail/T14605.stderr b/testsuite/tests/typecheck/should_fail/T14605.stderr new file mode 100644 index 0000000000..09181c6ee8 --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T14605.stderr @@ -0,0 +1,10 @@ + +T14605.hs:14:13: error: + • Couldn't match representation of type ‘x1’ with that of ‘()’ + arising from a use of ‘coerce’ + ‘x1’ is a rigid type variable bound by + the type () + at T14605.hs:14:1-49 + • In the expression: coerce @(forall x. ()) @(forall x. x) + In an equation for ‘duplicate’: + duplicate = coerce @(forall x. ()) @(forall x. x) diff --git a/testsuite/tests/typecheck/should_fail/T14607.hs b/testsuite/tests/typecheck/should_fail/T14607.hs new file mode 100644 index 0000000000..86c738dc19 --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T14607.hs @@ -0,0 +1,34 @@ +{-# OPTIONS_GHC -fdefer-type-errors #-} + -- This line is crucial to the bug + +{-# Language GADTs #-} +{-# Language InstanceSigs #-} +{-# Language KindSignatures #-} +{-# Language TypeFamilies #-} +{-# Language DataKinds #-} +{-# Language FlexibleInstances #-} + +module T14607 where + +import Data.Kind + +data LamCons :: Type -> Type -> () -> Type where + C :: LamCons a a '() + +class Mk a where + mk :: LamCons a a '() + +instance Mk a where + mk :: LamCons a '() + mk = mk + +-- At some point, this program was accepted. That's fine. But right now, +-- it's rejected with a kind error, and we can't generally defer kind +-- errors, so I'm saying that behavior is OK. + +-- Later (May 18) the kind error ended up being in an term-level +-- implication constraint, which /does/ have an evidence binding +-- So now the kind error can be deferred. +-- Consequence of a fast-path for tcImplicitTKBndrsX I think. + + diff --git a/testsuite/tests/typecheck/should_fail/T14607.stderr b/testsuite/tests/typecheck/should_fail/T14607.stderr new file mode 100644 index 0000000000..740f89a0d4 --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T14607.stderr @@ -0,0 +1,21 @@ + +T14607.hs:22:9: warning: [-Wdeferred-type-errors (in -Wdefault)] + • Expecting one more argument to ‘LamCons a '()’ + Expected a type, but ‘LamCons a '()’ has kind ‘() -> *’ + • In the type signature: mk :: LamCons a '() + In the instance declaration for ‘Mk a’ + +T14607.hs:22:19: warning: [-Wdeferred-type-errors (in -Wdefault)] + • Expected a type, but ‘ '()’ has kind ‘()’ + • In the second argument of ‘LamCons’, namely ‘ '()’ + In the type signature: mk :: LamCons a '() + In the instance declaration for ‘Mk a’ + +T14607.hs:23:8: warning: [-Wdeferred-type-errors (in -Wdefault)] + • Couldn't match expected type ‘LamCons a '()’ + with actual type ‘LamCons a0 a0 '()’ + • In the expression: mk + In an equation for ‘mk’: mk = mk + In the instance declaration for ‘Mk a’ + • Relevant bindings include + mk :: LamCons a '() (bound at T14607.hs:23:3) diff --git a/testsuite/tests/typecheck/should_fail/T14618.hs b/testsuite/tests/typecheck/should_fail/T14618.hs new file mode 100644 index 0000000000..da30d7ad85 --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T14618.hs @@ -0,0 +1,11 @@ +{-# LANGUAGE RankNTypes #-} + +module T14618 where + +safeCoerce :: a -> b +safeCoerce = f' + where + f :: d -> forall c. d + f x = x + + f' = f diff --git a/testsuite/tests/typecheck/should_fail/T14618.stderr b/testsuite/tests/typecheck/should_fail/T14618.stderr new file mode 100644 index 0000000000..8faa64c25e --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T14618.stderr @@ -0,0 +1,23 @@ + +T14618.hs:6:14: error: + • Couldn't match type ‘a’ with ‘b’ + ‘a’ is a rigid type variable bound by + the type signature for: + safeCoerce :: forall a b. a -> b + at T14618.hs:5:1-20 + ‘b’ is a rigid type variable bound by + the type signature for: + safeCoerce :: forall a b. a -> b + at T14618.hs:5:1-20 + Expected type: a -> b + Actual type: b -> b + • In the expression: f' + In an equation for ‘safeCoerce’: + safeCoerce + = f' + where + f :: d -> forall c. d + f x = x + f' = f + • Relevant bindings include + safeCoerce :: a -> b (bound at T14618.hs:6:1) diff --git a/testsuite/tests/typecheck/should_fail/T14761a.hs b/testsuite/tests/typecheck/should_fail/T14761a.hs new file mode 100644 index 0000000000..f195320186 --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T14761a.hs @@ -0,0 +1,3 @@ +module T14761a where + +data A = A { a :: {-# UNPACK #-} Maybe Int} diff --git a/testsuite/tests/typecheck/should_fail/T14761a.stderr b/testsuite/tests/typecheck/should_fail/T14761a.stderr new file mode 100644 index 0000000000..8eb4580db4 --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T14761a.stderr @@ -0,0 +1,7 @@ + +T14761a.hs:3:19: + Unexpected UNPACK annotation: {-# UNPACK #-}Maybe + UNPACK annotation cannot appear nested inside a type + In the type ‘{-# UNPACK #-}Maybe Int’ + In the definition of data constructor ‘A’ + In the data declaration for ‘A’ diff --git a/testsuite/tests/typecheck/should_fail/T14761b.hs b/testsuite/tests/typecheck/should_fail/T14761b.hs new file mode 100644 index 0000000000..cd5196259f --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T14761b.hs @@ -0,0 +1,5 @@ +{-# LANGUAGE BangPatterns #-} + +module T14761b where + +data A = A { a :: ! Maybe Int} diff --git a/testsuite/tests/typecheck/should_fail/T14761b.stderr b/testsuite/tests/typecheck/should_fail/T14761b.stderr new file mode 100644 index 0000000000..8357187928 --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T14761b.stderr @@ -0,0 +1,7 @@ + +T14761b.hs:5:19: + Unexpected strictness annotation: !Maybe + strictness annotation cannot appear nested inside a type + In the type ‘!Maybe Int’ + In the definition of data constructor ‘A’ + In the data declaration for ‘A’ diff --git a/testsuite/tests/typecheck/should_fail/T14884.hs b/testsuite/tests/typecheck/should_fail/T14884.hs new file mode 100644 index 0000000000..d5d1545fe0 --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T14884.hs @@ -0,0 +1,4 @@ +module T14884 where + +x :: IO () +x = _ print "abc" diff --git a/testsuite/tests/typecheck/should_fail/T14884.stderr b/testsuite/tests/typecheck/should_fail/T14884.stderr new file mode 100644 index 0000000000..cb85da14a5 --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T14884.stderr @@ -0,0 +1,49 @@ + +T14884.hs:4:5: error: + • Found hole: _ :: (a0 -> IO ()) -> [Char] -> IO () + Where: ‘a0’ is an ambiguous type variable + • In the expression: _ + In the expression: _ print "abc" + In an equation for ‘x’: x = _ print "abc" + • Relevant bindings include x :: IO () (bound at T14884.hs:4:1) + Valid hole fits include + mapM_ :: forall (t :: * -> *) (m :: * -> *) a b. + (Foldable t, Monad m) => + (a -> m b) -> t a -> m () + with mapM_ @[] @IO @Char @() + (imported from ‘Prelude’ at T14884.hs:1:8-13 + (and originally defined in ‘Data.Foldable’)) + foldMap :: forall (t :: * -> *) m a. + (Foldable t, Monoid m) => + (a -> m) -> t a -> m + with foldMap @[] @(IO ()) @Char + (imported from ‘Prelude’ at T14884.hs:1:8-13 + (and originally defined in ‘Data.Foldable’)) + ($) :: forall a b. (a -> b) -> a -> b + with ($) @'GHC.Types.LiftedRep @[Char] @(IO ()) + (imported from ‘Prelude’ at T14884.hs:1:8-13 + (and originally defined in ‘GHC.Base’)) + ($!) :: forall a b. (a -> b) -> a -> b + with ($!) @'GHC.Types.LiftedRep @[Char] @(IO ()) + (imported from ‘Prelude’ at T14884.hs:1:8-13 + (and originally defined in ‘GHC.Base’)) + id :: forall a. a -> a + with id @([Char] -> IO ()) + (imported from ‘Prelude’ at T14884.hs:1:8-13 + (and originally defined in ‘GHC.Base’)) + +T14884.hs:4:7: error: + • Ambiguous type variable ‘a0’ arising from a use of ‘print’ + prevents the constraint ‘(Show a0)’ from being solved. + Probable fix: use a type annotation to specify what ‘a0’ should be. + These potential instances exist: + instance (Show a, Show b) => Show (Either a b) + -- Defined in ‘Data.Either’ + instance Show Ordering -- Defined in ‘GHC.Show’ + instance Show Integer -- Defined in ‘GHC.Show’ + ...plus 23 others + ...plus 67 instances involving out-of-scope types + (use -fprint-potential-instances to see them all) + • In the first argument of ‘_’, namely ‘print’ + In the expression: _ print "abc" + In an equation for ‘x’: x = _ print "abc" diff --git a/testsuite/tests/typecheck/should_fail/T14904a.hs b/testsuite/tests/typecheck/should_fail/T14904a.hs new file mode 100644 index 0000000000..af4cf65a33 --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T14904a.hs @@ -0,0 +1,9 @@ +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE PolyKinds #-} +module T14904a where + +import Data.Kind + +type family F (f :: forall a. g a) :: Type where + F (f :: forall a. g a) = Int diff --git a/testsuite/tests/typecheck/should_fail/T14904a.stderr b/testsuite/tests/typecheck/should_fail/T14904a.stderr new file mode 100644 index 0000000000..ea92de3465 --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T14904a.stderr @@ -0,0 +1,5 @@ + +T14904a.hs:9:6: error: + • Expected kind ‘forall (a :: k1). g a’, but ‘f’ has kind ‘k0’ + • In the first argument of ‘F’, namely ‘(f :: forall a. g a)’ + In the type family declaration for ‘F’ diff --git a/testsuite/tests/typecheck/should_fail/T14904b.hs b/testsuite/tests/typecheck/should_fail/T14904b.hs new file mode 100644 index 0000000000..529b273245 --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T14904b.hs @@ -0,0 +1,9 @@ +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE PolyKinds #-} +module T14904b where + +import Data.Kind + +type family F f :: Type where + F ((f :: forall a. g a) :: forall a. g a) = Int diff --git a/testsuite/tests/typecheck/should_fail/T14904b.stderr b/testsuite/tests/typecheck/should_fail/T14904b.stderr new file mode 100644 index 0000000000..fff6942af1 --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T14904b.stderr @@ -0,0 +1,6 @@ + +T14904b.hs:9:7: error: + • Expected kind ‘forall (a :: k1). g a’, but ‘f’ has kind ‘k0’ + • In the first argument of ‘F’, namely + ‘((f :: forall a. g a) :: forall a. g a)’ + In the type family declaration for ‘F’ diff --git a/testsuite/tests/typecheck/should_fail/T15067.hs b/testsuite/tests/typecheck/should_fail/T15067.hs new file mode 100644 index 0000000000..397655f60c --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T15067.hs @@ -0,0 +1,9 @@ +{-# LANGUAGE UnboxedSums #-} +{-# LANGUAGE DataKinds #-} + +module T15067 where + +import Type.Reflection + +floopadoop :: TypeRep (# Bool | Int #) +floopadoop = typeRep diff --git a/testsuite/tests/typecheck/should_fail/T15067.stderr b/testsuite/tests/typecheck/should_fail/T15067.stderr new file mode 100644 index 0000000000..4ed3d3bc0a --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T15067.stderr @@ -0,0 +1,13 @@ + +T15067.hs:9:14: error: + • No instance for (Typeable (# 'GHC.Types.LiftedRep #)) + arising from a use of ‘typeRep’ + GHC can't yet do polykinded + Typeable ((# 'GHC.Types.LiftedRep #) :: * + -> * + -> TYPE + ('GHC.Types.SumRep + '[ 'GHC.Types.LiftedRep, + 'GHC.Types.LiftedRep])) + • In the expression: typeRep + In an equation for ‘floopadoop’: floopadoop = typeRep diff --git a/testsuite/tests/typecheck/should_fail/T15330.hs b/testsuite/tests/typecheck/should_fail/T15330.hs new file mode 100644 index 0000000000..0041806244 --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T15330.hs @@ -0,0 +1,15 @@ +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE TypeInType #-} +module T15330 where + +import Data.Kind +import Data.Proxy + +data T :: forall a. a -> Type + +f1 :: Proxy (T True) +f1 = "foo" + +f2 :: forall (t :: forall a. a -> Type). + Proxy (t True) +f2 = "foo" diff --git a/testsuite/tests/typecheck/should_fail/T15330.stderr b/testsuite/tests/typecheck/should_fail/T15330.stderr new file mode 100644 index 0000000000..cef80452a1 --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T15330.stderr @@ -0,0 +1,14 @@ + +T15330.hs:11:6: error: + • Couldn't match expected type ‘Proxy (T 'True)’ + with actual type ‘[Char]’ + • In the expression: "foo" + In an equation for ‘f1’: f1 = "foo" + +T15330.hs:15:6: error: + • Couldn't match expected type ‘Proxy (t 'True)’ + with actual type ‘[Char]’ + • In the expression: "foo" + In an equation for ‘f2’: f2 = "foo" + • Relevant bindings include + f2 :: Proxy (t 'True) (bound at T15330.hs:15:1) diff --git a/testsuite/tests/typecheck/should_fail/T15361.hs b/testsuite/tests/typecheck/should_fail/T15361.hs new file mode 100644 index 0000000000..53ae965e21 --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T15361.hs @@ -0,0 +1,20 @@ +{-# LANGUAGE GADTs #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE TypeOperators #-} +module T15361 where + +import Data.Kind +import Data.Type.Equality + +-- Don't report (* ~ *) here +foo :: forall (a :: Type) (b :: Type) (c :: Type). + a :~~: b -> a :~~: c +foo HRefl = HRefl + +data Chumbawamba :: Type -> Type where + IGetKnockedDown :: (Eq a, Ord a) => a -> Chumbawamba a + +-- Don't report (Eq a) here +goo :: Chumbawamba a -> String +goo (IGetKnockedDown x) = show x diff --git a/testsuite/tests/typecheck/should_fail/T15361.stderr b/testsuite/tests/typecheck/should_fail/T15361.stderr new file mode 100644 index 0000000000..93b01742ff --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T15361.stderr @@ -0,0 +1,36 @@ + +T15361.hs:13:13: error: + • Could not deduce: a ~ c + from the context: b ~ a + bound by a pattern with constructor: + HRefl :: forall k1 (a :: k1). a :~~: a, + in an equation for ‘foo’ + at T15361.hs:13:5-9 + ‘a’ is a rigid type variable bound by + the type signature for: + foo :: forall a b c. (a :~~: b) -> a :~~: c + at T15361.hs:(11,1)-(12,27) + ‘c’ is a rigid type variable bound by + the type signature for: + foo :: forall a b c. (a :~~: b) -> a :~~: c + at T15361.hs:(11,1)-(12,27) + Expected type: a :~~: c + Actual type: a :~~: a + • In the expression: HRefl + In an equation for ‘foo’: foo HRefl = HRefl + • Relevant bindings include + foo :: (a :~~: b) -> a :~~: c (bound at T15361.hs:13:1) + +T15361.hs:20:27: error: + • Could not deduce (Show a) arising from a use of ‘show’ + from the context: Ord a + bound by a pattern with constructor: + IGetKnockedDown :: forall a. (Eq a, Ord a) => a -> Chumbawamba a, + in an equation for ‘goo’ + at T15361.hs:20:6-22 + Possible fix: + add (Show a) to the context of + the type signature for: + goo :: forall a. Chumbawamba a -> String + • In the expression: show x + In an equation for ‘goo’: goo (IGetKnockedDown x) = show x diff --git a/testsuite/tests/typecheck/should_fail/T15438.hs b/testsuite/tests/typecheck/should_fail/T15438.hs new file mode 100644 index 0000000000..0f995389a0 --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T15438.hs @@ -0,0 +1,8 @@ +{-# LANGUAGE MultiParamTypeClasses, RankNTypes #-} + +module T15438 where + +class C a b + +foo :: (forall a b. C a b => b -> b) -> Int +foo = error "urk" diff --git a/testsuite/tests/typecheck/should_fail/T15438.stderr b/testsuite/tests/typecheck/should_fail/T15438.stderr new file mode 100644 index 0000000000..473d5dcc98 --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T15438.stderr @@ -0,0 +1,11 @@ + +T15438.hs:7:8: error: + • Could not deduce (C a0 b) + from the context: C a b + bound by a type expected by the context: + forall a b. C a b => b -> b + at T15438.hs:7:8-43 + The type variable ‘a0’ is ambiguous + • In the ambiguity check for ‘foo’ + To defer the ambiguity check to use sites, enable AllowAmbiguousTypes + In the type signature: foo :: (forall a b. C a b => b -> b) -> Int diff --git a/testsuite/tests/typecheck/should_fail/T15515.hs b/testsuite/tests/typecheck/should_fail/T15515.hs new file mode 100644 index 0000000000..3630609827 --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T15515.hs @@ -0,0 +1,20 @@ +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeInType #-} +module T15515 where + +import Data.Kind +import Data.Proxy + +class C a where + c :: Proxy a + +type family F + +data D :: F -> Type + +instance C (D :: F -> Type) where + c = Proxy + +c' :: Proxy (D :: F -> Type) +c' = c @(D :: F -> Type) diff --git a/testsuite/tests/typecheck/should_fail/T15515.stderr b/testsuite/tests/typecheck/should_fail/T15515.stderr new file mode 100644 index 0000000000..f58d8afb2d --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T15515.stderr @@ -0,0 +1,6 @@ + +T15515.hs:16:10: error: + • Illegal type synonym family application ‘F’ in instance: + C D + Use -fprint-explicit-kinds to see the kind arguments + • In the instance declaration for ‘C (D :: F -> Type)’ diff --git a/testsuite/tests/typecheck/should_fail/T15523.hs b/testsuite/tests/typecheck/should_fail/T15523.hs new file mode 100644 index 0000000000..89b1bb4a5d --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T15523.hs @@ -0,0 +1,6 @@ +{-# LANGUAGE StrictData #-} + +module T15523 where + +newtype Duration = Foo +data Literal = LitDuration Duration diff --git a/testsuite/tests/typecheck/should_fail/T15523.stderr b/testsuite/tests/typecheck/should_fail/T15523.stderr new file mode 100644 index 0000000000..83b7cdbc60 --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T15523.stderr @@ -0,0 +1,6 @@ + +T15523.hs:5:20: error: + • The constructor of a newtype must have exactly one field + but ‘Foo’ has none + • In the definition of data constructor ‘Foo’ + In the newtype declaration for ‘Duration’ diff --git a/testsuite/tests/typecheck/should_fail/T15527.hs b/testsuite/tests/typecheck/should_fail/T15527.hs new file mode 100644 index 0000000000..b65c26ca7a --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T15527.hs @@ -0,0 +1,4 @@ +module T15527 where + +f :: (Int -> Int) -> (Int -> Int) -> (Int -> Int) +f = (.) @Int diff --git a/testsuite/tests/typecheck/should_fail/T15527.stderr b/testsuite/tests/typecheck/should_fail/T15527.stderr new file mode 100644 index 0000000000..dd03a0a0ca --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T15527.stderr @@ -0,0 +1,4 @@ + +T15527.hs:4:6: error: + Pattern syntax in expression context: (.)@Int + Did you mean to enable TypeApplications? diff --git a/testsuite/tests/typecheck/should_fail/T15552.hs b/testsuite/tests/typecheck/should_fail/T15552.hs new file mode 100644 index 0000000000..f1952cc10b --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T15552.hs @@ -0,0 +1,17 @@ +{-# LANGUAGE DataKinds, ExistentialQuantification, GADTs, PolyKinds, TypeOperators #-} +{-# LANGUAGE TypeInType, TypeFamilies #-} +module T15552 where + +import Data.Kind + +data Elem :: k -> [k] -> Type + +data EntryOfVal (v :: Type) (kvs :: [Type]) where + EntryOfVal :: forall (v :: Type) (kvs :: [Type]) (k :: Type). + Elem (k, v) kvs -> EntryOfVal v kvs + +type family EntryOfValKey (eov :: EntryOfVal v kvs) :: Type + +type family GetEntryOfVal (eov :: EntryOfVal v kvs) :: Elem (EntryOfValKey eov, v) kvs + +type family FirstEntryOfVal (v :: Type) (kvs :: [Type]) :: EntryOfVal v kvs where diff --git a/testsuite/tests/typecheck/should_fail/T15552a.hs b/testsuite/tests/typecheck/should_fail/T15552a.hs new file mode 100644 index 0000000000..86c71dc9c0 --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T15552a.hs @@ -0,0 +1,28 @@ +{-# LANGUAGE DataKinds, ExistentialQuantification, GADTs, PolyKinds, TypeOperators #-} +{-# LANGUAGE TypeInType, TypeFamilies #-} +{- # LANGUAGE UndecidableInstances #-} +module T15552 where + +import Data.Kind + +data Elem :: k -> [k] -> Type where + Here :: Elem x (x : xs) + There :: Elem x xs -> Elem x (y : xs) + +data EntryOfVal (v :: Type) (kvs :: [Type]) where + EntryOfVal :: forall (v :: Type) (kvs :: [Type]) (k :: Type). + Elem (k, v) kvs -> EntryOfVal v kvs + +type family EntryOfValKey (eov :: EntryOfVal v kvs) :: Type where + EntryOfValKey ('EntryOfVal (_ :: Elem (k, v) kvs)) = k + +type family GetEntryOfVal (eov :: EntryOfVal v kvs) + :: Elem (EntryOfValKey eov, v) kvs + where + GetEntryOfVal ('EntryOfVal e) = e + +type family FirstEntryOfVal (v :: Type) (kvs :: [Type]) :: EntryOfVal v kvs + where FirstEntryOfVal v (_ : kvs) + = 'EntryOfVal (There (GetEntryOfVal (FirstEntryOfVal v kvs))) +--type instance FirstEntryOfVal v (_ : kvs) +-- = 'EntryOfVal ('There (GetEntryOfVal (FirstEntryOfVal v kvs))) diff --git a/testsuite/tests/typecheck/should_fail/T15552a.stderr b/testsuite/tests/typecheck/should_fail/T15552a.stderr new file mode 100644 index 0000000000..f24c6d1285 --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T15552a.stderr @@ -0,0 +1,21 @@ + +T15552a.hs:25:9: error: + • Illegal nested type family application ‘EntryOfValKey + (FirstEntryOfVal v kvs)’ + (Use UndecidableInstances to permit this) + • In the equations for closed type family ‘FirstEntryOfVal’ + In the type family declaration for ‘FirstEntryOfVal’ + +T15552a.hs:25:9: error: + • Illegal nested type family application ‘EntryOfValKey + (FirstEntryOfVal v kvs)’ + (Use UndecidableInstances to permit this) + • In the equations for closed type family ‘FirstEntryOfVal’ + In the type family declaration for ‘FirstEntryOfVal’ + +T15552a.hs:25:9: error: + • Illegal nested type family application ‘GetEntryOfVal + (FirstEntryOfVal v kvs)’ + (Use UndecidableInstances to permit this) + • In the equations for closed type family ‘FirstEntryOfVal’ + In the type family declaration for ‘FirstEntryOfVal’ diff --git a/testsuite/tests/typecheck/should_fail/T15629.hs b/testsuite/tests/typecheck/should_fail/T15629.hs new file mode 100644 index 0000000000..fdbba60ccc --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T15629.hs @@ -0,0 +1,27 @@ +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeInType #-} +{-# LANGUAGE TypeOperators #-} +module Bug (f) where + +import Data.Kind +import Data.Proxy + +data TyFun :: Type -> Type -> Type +type a ~> b = TyFun a b -> Type +infixr 0 ~> + +type family F x :: Type -> Type +data F1Sym :: forall x a. x ~> F x a +data F2Sym :: forall x a. F x a ~> x +data Comp :: forall b c a. (b ~> c) -> (a ~> b) -> (a ~> c) + +sg :: forall a b c (f :: b ~> c) (g :: a ~> b) (x :: a). + Proxy f -> Proxy g -> Proxy (Comp f g) +sg _ _ = Proxy + +f :: forall (x :: Type). Proxy x -> () +f _ = () + where + g :: forall ab. Proxy ((Comp (F1Sym :: x ~> F x z) F2Sym) :: F x ab ~> F x ab) + g = sg Proxy Proxy diff --git a/testsuite/tests/typecheck/should_fail/T15629.stderr b/testsuite/tests/typecheck/should_fail/T15629.stderr new file mode 100644 index 0000000000..d3f0978ecf --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T15629.stderr @@ -0,0 +1,39 @@ + +T15629.hs:26:34: error: + • Expected kind ‘x1 ~> F x1 ab1’, + but ‘(F1Sym :: x ~> F x z)’ has kind ‘x1 ~> F x1 z’ + • In the first argument of ‘Comp’, namely ‘(F1Sym :: x ~> F x z)’ + In the first argument of ‘Proxy’, namely + ‘((Comp (F1Sym :: x ~> F x z) F2Sym) :: F x ab ~> F x ab)’ + In the type signature: + g :: forall ab. + Proxy ((Comp (F1Sym :: x ~> F x z) F2Sym) :: F x ab ~> F x ab) + +T15629.hs:27:9: error: + • Couldn't match kind ‘ab1’ with ‘z’ + ‘ab1’ is a rigid type variable bound by + the type signature for: + g :: forall z1 ab1. Proxy (Comp F1Sym F2Sym) + at T15629.hs:26:5-82 + ‘z’ is a rigid type variable bound by + the type signature for: + g :: forall z1 ab1. Proxy (Comp F1Sym F2Sym) + at T15629.hs:26:5-82 + When matching types + f0 :: x ~> F x ab + F1Sym :: TyFun x1 (F x1 z) -> * + Expected type: Proxy (Comp F1Sym F2Sym) + Actual type: Proxy (Comp f0 F2Sym) + • In the expression: sg Proxy Proxy + In an equation for ‘g’: g = sg Proxy Proxy + In an equation for ‘f’: + f _ + = () + where + g :: + forall ab. + Proxy ((Comp (F1Sym :: x ~> F x z) F2Sym) :: F x ab ~> F x ab) + g = sg Proxy Proxy + • Relevant bindings include + g :: Proxy (Comp F1Sym F2Sym) (bound at T15629.hs:27:5) + f :: Proxy x1 -> () (bound at T15629.hs:24:1) diff --git a/testsuite/tests/typecheck/should_fail/T1633.stderr b/testsuite/tests/typecheck/should_fail/T1633.stderr index 300e6c3def..5d9dcc44f5 100644 --- a/testsuite/tests/typecheck/should_fail/T1633.stderr +++ b/testsuite/tests/typecheck/should_fail/T1633.stderr @@ -1,5 +1,5 @@ T1633.hs:8:18: error: - Expected kind ‘* -> *’, but ‘Bool’ has kind ‘*’ - In the first argument of ‘Functor’, namely ‘Bool’ - In the instance declaration for ‘Functor Bool’ + • Expected kind ‘* -> *’, but ‘Bool’ has kind ‘*’ + • In the first argument of ‘Functor’, namely ‘Bool’ + In the instance declaration for ‘Functor Bool’ diff --git a/testsuite/tests/typecheck/should_fail/T2994.stderr b/testsuite/tests/typecheck/should_fail/T2994.stderr index 4777e486e6..09b36165a6 100644 --- a/testsuite/tests/typecheck/should_fail/T2994.stderr +++ b/testsuite/tests/typecheck/should_fail/T2994.stderr @@ -5,12 +5,20 @@ T2994.hs:11:10: error: but ‘MonadReader Int’ has kind ‘* -> Constraint’ • In the instance declaration for ‘MonadReader Int’ +T2994.hs:11:10: error: + • Instance head is not headed by a class: MonadReader Int + • In the instance declaration for ‘MonadReader Int’ + T2994.hs:13:10: error: • Expecting one more argument to ‘MonadReader (Reader' r)’ Expected a constraint, but ‘MonadReader (Reader' r)’ has kind ‘* -> Constraint’ • In the instance declaration for ‘MonadReader (Reader' r)’ +T2994.hs:13:10: error: + • Instance head is not headed by a class: MonadReader (Reader' r) + • In the instance declaration for ‘MonadReader (Reader' r)’ + T2994.hs:13:23: error: • Expecting one more argument to ‘Reader' r’ Expected a type, but ‘Reader' r’ has kind ‘* -> *’ @@ -18,7 +26,11 @@ T2994.hs:13:23: error: In the instance declaration for ‘MonadReader (Reader' r)’ T2994.hs:15:10: error: - • Expecting one fewer arguments to ‘MonadReader r r’ - Expected kind ‘(* -> *) -> Constraint’, + • Expected kind ‘(* -> *) -> Constraint’, but ‘MonadReader r r’ has kind ‘Constraint’ • In the instance declaration for ‘MonadReader r r (Reader' r)’ + +T2994.hs:15:10: error: + • Instance head is not headed by a class: + MonadReader r r (Reader' r) + • In the instance declaration for ‘MonadReader r r (Reader' r)’ diff --git a/testsuite/tests/typecheck/should_fail/T3468.stderr b/testsuite/tests/typecheck/should_fail/T3468.stderr index 1f8bdcb11b..0a0fec223b 100644 --- a/testsuite/tests/typecheck/should_fail/T3468.stderr +++ b/testsuite/tests/typecheck/should_fail/T3468.stderr @@ -3,7 +3,6 @@ T3468.hs-boot:3:1: error: Type constructor ‘Tool’ has conflicting definitions in the module and its hs-boot file Main module: type role Tool phantom - data Tool d where - F :: a -> Tool d + data Tool d = forall a r. F a Boot file: data Tool The types have different kinds diff --git a/testsuite/tests/typecheck/should_fail/T3540.stderr b/testsuite/tests/typecheck/should_fail/T3540.stderr index 1723e86bbe..eeb2c051f2 100644 --- a/testsuite/tests/typecheck/should_fail/T3540.stderr +++ b/testsuite/tests/typecheck/should_fail/T3540.stderr @@ -3,6 +3,16 @@ T3540.hs:4:12: error: • Expected a type, but ‘a ~ Int’ has kind ‘Constraint’ • In the type signature: thing :: (a ~ Int) +T3540.hs:5:9: error: + • Couldn't match kind ‘Constraint’ with ‘*’ + When matching types + a0 :: * + a ~ Int :: Constraint + • In the expression: undefined + In an equation for ‘thing’: thing = undefined + • Relevant bindings include + thing :: a ~ Int (bound at T3540.hs:5:1) + T3540.hs:7:20: error: • Expected a type, but ‘a ~ Int’ has kind ‘Constraint’ • In the type signature: thing1 :: Int -> (a ~ Int) @@ -12,7 +22,7 @@ T3540.hs:10:13: error: • In the type signature: thing2 :: (a ~ Int) -> Int T3540.hs:13:12: error: - • Expected a type, but ‘?dude::Int’ has kind ‘Constraint’ + • Expected a type, but ‘?dude :: Int’ has kind ‘Constraint’ • In the type signature: thing3 :: (?dude :: Int) -> Int T3540.hs:16:11: error: diff --git a/testsuite/tests/typecheck/should_fail/T4875.stderr b/testsuite/tests/typecheck/should_fail/T4875.stderr index 782b0969d5..48808e319c 100644 --- a/testsuite/tests/typecheck/should_fail/T4875.stderr +++ b/testsuite/tests/typecheck/should_fail/T4875.stderr @@ -1,7 +1,5 @@ T4875.hs:27:24: error: - • Expecting one fewer arguments to ‘r’ - Expected kind ‘* -> *’, but ‘r’ has kind ‘*’ - • In the type signature: - multiplicities :: r c -> [c] + • Expected kind ‘* -> *’, but ‘r’ has kind ‘*’ + • In the type signature: multiplicities :: r c -> [c] In the class declaration for ‘Morphic’ diff --git a/testsuite/tests/typecheck/should_fail/T5095.stderr b/testsuite/tests/typecheck/should_fail/T5095.stderr index 14d864a592..ace7e916c8 100644 --- a/testsuite/tests/typecheck/should_fail/T5095.stderr +++ b/testsuite/tests/typecheck/should_fail/T5095.stderr @@ -5,9 +5,9 @@ T5095.hs:9:9: error: instance [overlappable] Show a => Eq a -- Defined at T5095.hs:5:31 instance Eq Ordering -- Defined in ‘GHC.Classes’ instance Eq Integer - -- Defined in ‘integer-gmp-1.0.0.1:GHC.Integer.Type’ + -- Defined in ‘integer-gmp-1.0.1.0:GHC.Integer.Type’ ...plus 23 others - ...plus five instances involving out-of-scope types + ...plus 7 instances involving out-of-scope types (use -fprint-potential-instances to see them all) (The choice depends on the instantiation of ‘a’ To pick the first instance above, use IncoherentInstances diff --git a/testsuite/tests/typecheck/should_fail/T5689.stderr b/testsuite/tests/typecheck/should_fail/T5689.stderr index 2c7eaa87d4..5385f578b1 100644 --- a/testsuite/tests/typecheck/should_fail/T5689.stderr +++ b/testsuite/tests/typecheck/should_fail/T5689.stderr @@ -1,10 +1,6 @@ -T5689.hs:10:36: error: - • Couldn't match expected type ‘Bool’ with actual type ‘t’ - • In the expression: v - In the expression: if v then False else True - In the second argument of ‘writeIORef’, namely - ‘(\ v -> if v then False else True)’ - • Relevant bindings include - v :: t (bound at T5689.hs:10:28) - r :: IORef (t -> t) (bound at T5689.hs:7:14) +T5689.hs:15:23: error: + • No instance for (Num Bool) arising from the literal ‘1234’ + • In the first argument of ‘c’, namely ‘1234’ + In the second argument of ‘($)’, namely ‘c 1234’ + In a stmt of a 'do' block: print $ c 1234 diff --git a/testsuite/tests/typecheck/should_fail/T5691.stderr b/testsuite/tests/typecheck/should_fail/T5691.stderr index ad5c7e452f..d06a4f43a8 100644 --- a/testsuite/tests/typecheck/should_fail/T5691.stderr +++ b/testsuite/tests/typecheck/should_fail/T5691.stderr @@ -1,13 +1,4 @@ -T5691.hs:14:9: error: - • Couldn't match type ‘p’ with ‘PrintRuleInterp’ - Expected type: PrintRuleInterp a - Actual type: p a - • When checking that the pattern signature: p a - fits the type of its context: PrintRuleInterp a - In the pattern: f :: p a - In an equation for ‘test’: test (f :: p a) = MkPRI $ printRule_ f - T5691.hs:24:10: error: • No instance for (Alternative RecDecParser) arising from the superclasses of an instance declaration diff --git a/testsuite/tests/typecheck/should_fail/T5853.stderr b/testsuite/tests/typecheck/should_fail/T5853.stderr index 719895af6c..573a532f10 100644 --- a/testsuite/tests/typecheck/should_fail/T5853.stderr +++ b/testsuite/tests/typecheck/should_fail/T5853.stderr @@ -2,18 +2,12 @@ T5853.hs:15:46: error: • Could not deduce: Subst (Subst fa a) b ~ Subst fa b arising from a use of ‘<$>’ - from the context: (F fa, - Elem fa ~ Elem fa, - Elem (Subst fa b) ~ b, - Subst fa b ~ Subst fa b, - Subst (Subst fa b) (Elem fa) ~ fa, - F (Subst fa a), - Elem (Subst fa a) ~ a, - Elem fa ~ Elem fa, - Subst (Subst fa a) (Elem fa) ~ fa, - Subst fa a ~ Subst fa a) + from the context: (F fa, Elem (Subst fa b) ~ b, + Subst fa b ~ Subst fa b, Subst (Subst fa b) (Elem fa) ~ fa, + F (Subst fa a), Elem (Subst fa a) ~ a, Elem fa ~ Elem fa, + Subst (Subst fa a) (Elem fa) ~ fa, Subst fa a ~ Subst fa a) bound by the RULE "map/map" at T5853.hs:15:2-57 - NB: ‘Subst’ is a type function, and may not be injective + NB: ‘Subst’ is a non-injective type family • In the expression: (f . g) <$> xs When checking the transformation rule "map/map" • Relevant bindings include diff --git a/testsuite/tests/typecheck/should_fail/T6018fail.stderr b/testsuite/tests/typecheck/should_fail/T6018fail.stderr index 8c7a273ed8..f2fdf82b25 100644 --- a/testsuite/tests/typecheck/should_fail/T6018fail.stderr +++ b/testsuite/tests/typecheck/should_fail/T6018fail.stderr @@ -153,5 +153,6 @@ T6018fail.hs:129:1: error: T6018fail.hs:134:1: error: Type family equation violates injectivity annotation. RHS of injective type family equation is a bare type variable - but these LHS type and kind patterns are not bare variables: ‘*’, ‘Char’ + but these LHS type and kind patterns are not bare variables: ‘*’, + ‘Char’ FC Char a = a -- Defined at T6018fail.hs:134:1 diff --git a/testsuite/tests/typecheck/should_fail/T7019.stderr b/testsuite/tests/typecheck/should_fail/T7019.stderr index 2db5bbb90b..09827e458b 100644 --- a/testsuite/tests/typecheck/should_fail/T7019.stderr +++ b/testsuite/tests/typecheck/should_fail/T7019.stderr @@ -2,4 +2,5 @@ T7019.hs:11:1: error: • Illegal polymorphic type: forall a. c (Free c a) A constraint must be a monotype + Perhaps you intended to use QuantifiedConstraints • In the type synonym declaration for ‘C’ diff --git a/testsuite/tests/typecheck/should_fail/T7019a.stderr b/testsuite/tests/typecheck/should_fail/T7019a.stderr index a50fbcf240..e0e0342b61 100644 --- a/testsuite/tests/typecheck/should_fail/T7019a.stderr +++ b/testsuite/tests/typecheck/should_fail/T7019a.stderr @@ -2,6 +2,7 @@ T7019a.hs:11:1: error: • Illegal polymorphic type: forall b. Context (Associated a b) A constraint must be a monotype + Perhaps you intended to use QuantifiedConstraints • In the context: forall b. Context (Associated a b) While checking the super-classes of class ‘Class’ In the class declaration for ‘Class’ diff --git a/testsuite/tests/typecheck/should_fail/T7210.stderr b/testsuite/tests/typecheck/should_fail/T7210.stderr index a7ee2afc85..314ffa70e7 100644 --- a/testsuite/tests/typecheck/should_fail/T7210.stderr +++ b/testsuite/tests/typecheck/should_fail/T7210.stderr @@ -1,6 +1,7 @@ T7210.hs:5:19: Unexpected strictness annotation: !IntMap + strictness annotation cannot appear nested inside a type In the type ‘!IntMap Int’ In the definition of data constructor ‘C’ In the data declaration for ‘T’ diff --git a/testsuite/tests/typecheck/should_fail/T7368.stderr b/testsuite/tests/typecheck/should_fail/T7368.stderr index f187aee61c..660ef98f26 100644 --- a/testsuite/tests/typecheck/should_fail/T7368.stderr +++ b/testsuite/tests/typecheck/should_fail/T7368.stderr @@ -1,7 +1,11 @@ T7368.hs:3:10: error: • Couldn't match kind ‘*’ with ‘* -> *’ - When matching the kind of ‘Maybe’ + When matching types + b0 :: * + Maybe :: * -> * + Expected type: a0 -> b0 + Actual type: c0 Maybe • In the first argument of ‘b’, namely ‘(l Nothing)’ In the expression: b (l Nothing) In an equation for ‘f’: f = b (l Nothing) diff --git a/testsuite/tests/typecheck/should_fail/T7368a.stderr b/testsuite/tests/typecheck/should_fail/T7368a.stderr index e55aab0e62..16c8326afe 100644 --- a/testsuite/tests/typecheck/should_fail/T7368a.stderr +++ b/testsuite/tests/typecheck/should_fail/T7368a.stderr @@ -5,7 +5,7 @@ T7368a.hs:8:6: error: f :: * -> * Bad :: (* -> *) -> * Expected type: f (Bad f) - Actual type: Bad (Bad f) + Actual type: Bad w0 • In the pattern: Bad x In an equation for ‘fun’: fun (Bad x) = True • Relevant bindings include diff --git a/testsuite/tests/typecheck/should_fail/T7437.stderr b/testsuite/tests/typecheck/should_fail/T7437.stderr index d6663df40e..9b75781411 100644 --- a/testsuite/tests/typecheck/should_fail/T7437.stderr +++ b/testsuite/tests/typecheck/should_fail/T7437.stderr @@ -11,9 +11,7 @@ T7437.hs:14:13: error: • Could not deduce (Put a0) from the context: (Put a, Generic t, GPut (Rep t)) bound by the type signature for: - put :: forall a. - Put a => - forall t. (Generic t, GPut (Rep t)) => t -> [()] + put :: forall a t. (Put a, Generic t, GPut (Rep t)) => t -> [()] at T7437.hs:14:13-15 The type variable ‘a0’ is ambiguous • In the ambiguity check for ‘put’ diff --git a/testsuite/tests/typecheck/should_fail/T7453.stderr b/testsuite/tests/typecheck/should_fail/T7453.stderr index 518d6fad05..d72b6d9a7a 100644 --- a/testsuite/tests/typecheck/should_fail/T7453.stderr +++ b/testsuite/tests/typecheck/should_fail/T7453.stderr @@ -1,67 +1,49 @@ -T7453.hs:9:15: error: - • Couldn't match type ‘p’ with ‘t’ - because type variable ‘t’ would escape its scope - This (rigid, skolem) type variable is bound by +T7453.hs:10:30: error: + • Couldn't match expected type ‘t’ with actual type ‘p’ + ‘t’ is a rigid type variable bound by the type signature for: z :: forall t. Id t at T7453.hs:8:11-19 - Expected type: Id t - Actual type: Id p - • In the expression: aux - In an equation for ‘z’: - z = aux - where - aux = Id v - In an equation for ‘cast1’: - cast1 v - = runId z - where - z :: Id t - z = aux - where - aux = Id v + ‘p’ is a rigid type variable bound by + the inferred type of cast1 :: p -> a + at T7453.hs:(7,1)-(10,30) + • In the first argument of ‘Id’, namely ‘v’ + In the expression: Id v + In an equation for ‘aux’: aux = Id v • Relevant bindings include - aux :: Id p (bound at T7453.hs:10:21) + aux :: Id t (bound at T7453.hs:10:21) z :: Id t (bound at T7453.hs:9:11) v :: p (bound at T7453.hs:7:7) cast1 :: p -> a (bound at T7453.hs:7:1) -T7453.hs:15:15: error: - • Couldn't match type ‘p’ with ‘t1’ - because type variable ‘t1’ would escape its scope - This (rigid, skolem) type variable is bound by +T7453.hs:16:33: error: + • Couldn't match expected type ‘t1’ with actual type ‘p’ + ‘t1’ is a rigid type variable bound by the type signature for: z :: forall t1. () -> t1 at T7453.hs:14:11-22 - Expected type: () -> t1 - Actual type: () -> p - • In the expression: aux - In an equation for ‘z’: - z = aux - where - aux = const v - In an equation for ‘cast2’: - cast2 v - = z () - where - z :: () -> t - z = aux - where - aux = const v + ‘p’ is a rigid type variable bound by + the inferred type of cast2 :: p -> t + at T7453.hs:(13,1)-(16,33) + • In the first argument of ‘const’, namely ‘v’ + In the expression: const v + In an equation for ‘aux’: aux = const v • Relevant bindings include - aux :: forall b. b -> p (bound at T7453.hs:16:21) + aux :: b -> t1 (bound at T7453.hs:16:21) z :: () -> t1 (bound at T7453.hs:15:11) v :: p (bound at T7453.hs:13:7) cast2 :: p -> t (bound at T7453.hs:13:1) T7453.hs:21:15: error: • Couldn't match expected type ‘t1’ with actual type ‘p’ - because type variable ‘t1’ would escape its scope - This (rigid, skolem) type variable is bound by + ‘t1’ is a rigid type variable bound by the type signature for: z :: forall t1. t1 at T7453.hs:20:11-16 + ‘p’ is a rigid type variable bound by + the inferred type of cast3 :: p -> t + at T7453.hs:(19,1)-(22,33) • In the expression: v In an equation for ‘z’: z = v diff --git a/testsuite/tests/typecheck/should_fail/T7609.stderr b/testsuite/tests/typecheck/should_fail/T7609.stderr index 24339311b8..32bc980fe9 100644 --- a/testsuite/tests/typecheck/should_fail/T7609.stderr +++ b/testsuite/tests/typecheck/should_fail/T7609.stderr @@ -2,16 +2,13 @@ T7609.hs:7:16: error: • Expecting one more argument to ‘Maybe’ Expected a type, but ‘Maybe’ has kind ‘* -> *’ - • In the type signature: - f :: (a `X` a, Maybe) + • In the type signature: f :: (a `X` a, Maybe) T7609.hs:10:7: error: - • Expected a constraint, but ‘X a a’ has kind ‘*’ - • In the type signature: - g :: (a `X` a) => Maybe + • Expected a constraint, but ‘a `X` a’ has kind ‘*’ + • In the type signature: g :: (a `X` a) => Maybe T7609.hs:10:19: error: • Expecting one more argument to ‘Maybe’ Expected a type, but ‘Maybe’ has kind ‘* -> *’ - • In the type signature: - g :: (a `X` a) => Maybe + • In the type signature: g :: (a `X` a) => Maybe diff --git a/testsuite/tests/typecheck/should_fail/T7645.hs b/testsuite/tests/typecheck/should_fail/T7645.hs index db086c8e61..b7a2af4ebd 100644 --- a/testsuite/tests/typecheck/should_fail/T7645.hs +++ b/testsuite/tests/typecheck/should_fail/T7645.hs @@ -1,8 +1,10 @@ {-# LANGUAGE TypeOperators, KindSignatures #-} module T7645 where +import Data.Kind + data (+) a b = P -f :: ((+) a (a :: *), Maybe) +f :: ((+) a (a :: Type), Maybe) f = undefined diff --git a/testsuite/tests/typecheck/should_fail/T7645.stderr b/testsuite/tests/typecheck/should_fail/T7645.stderr index 1b3fe0ad76..24330b2aeb 100644 --- a/testsuite/tests/typecheck/should_fail/T7645.stderr +++ b/testsuite/tests/typecheck/should_fail/T7645.stderr @@ -1,6 +1,5 @@ -T7645.hs:6:23: error: +T7645.hs:8:26: error: • Expecting one more argument to ‘Maybe’ Expected a type, but ‘Maybe’ has kind ‘* -> *’ - • In the type signature: - f :: ((+) a (a :: *), Maybe) + • In the type signature: f :: ((+) a (a :: Type), Maybe) diff --git a/testsuite/tests/typecheck/should_fail/T7696.stderr b/testsuite/tests/typecheck/should_fail/T7696.stderr index eef19a5cfc..41f2296797 100644 --- a/testsuite/tests/typecheck/should_fail/T7696.stderr +++ b/testsuite/tests/typecheck/should_fail/T7696.stderr @@ -1,7 +1,7 @@ T7696.hs:7:6: error: - • Couldn't match type ‘() a0’ with ‘()’ + • Couldn't match type ‘m0 a0’ with ‘()’ Expected type: ((), w ()) - Actual type: (() a0, w ()) + Actual type: (m0 a0, t0 m0) • In the expression: f1 In an equation for ‘f2’: f2 = f1 diff --git a/testsuite/tests/typecheck/should_fail/T7778.stderr b/testsuite/tests/typecheck/should_fail/T7778.stderr index 2db22e95ff..1993b772e0 100644 --- a/testsuite/tests/typecheck/should_fail/T7778.stderr +++ b/testsuite/tests/typecheck/should_fail/T7778.stderr @@ -1,12 +1,16 @@ +T7778.hs:3:6: error: + • Illegal qualified type: Num Int => Num + A constraint must be a monotype + Perhaps you intended to use QuantifiedConstraints + • In the type signature: v :: ((Num Int => Num) ()) => () + T7778.hs:3:7: error: - • Expecting one fewer arguments to ‘Num Int => Num’ - Expected kind ‘* -> Constraint’, but ‘Num Int => Num’ has kind ‘*’ - • In the type signature: - v :: ((Num Int => Num) ()) => () + • Expected kind ‘* -> Constraint’, + but ‘Num Int => Num’ has kind ‘*’ + • In the type signature: v :: ((Num Int => Num) ()) => () T7778.hs:3:19: error: • Expecting one more argument to ‘Num’ Expected a type, but ‘Num’ has kind ‘* -> Constraint’ - • In the type signature: - v :: ((Num Int => Num) ()) => () + • In the type signature: v :: ((Num Int => Num) ()) => () diff --git a/testsuite/tests/typecheck/should_fail/T7851.stderr b/testsuite/tests/typecheck/should_fail/T7851.stderr index 1a0274f8a3..0e1964e35c 100644 --- a/testsuite/tests/typecheck/should_fail/T7851.stderr +++ b/testsuite/tests/typecheck/should_fail/T7851.stderr @@ -1,7 +1,7 @@ T7851.hs:5:10: error: - • Couldn't match expected type ‘IO a1’ - with actual type ‘a0 -> IO ()’ + • Couldn't match expected type ‘IO a0’ + with actual type ‘a1 -> IO ()’ • Probable cause: ‘print’ is applied to too few arguments In a stmt of a 'do' block: print In the expression: diff --git a/testsuite/tests/typecheck/should_fail/T7869.stderr b/testsuite/tests/typecheck/should_fail/T7869.stderr index 4cf1cfaf67..7e01868526 100644 --- a/testsuite/tests/typecheck/should_fail/T7869.stderr +++ b/testsuite/tests/typecheck/should_fail/T7869.stderr @@ -1,11 +1,13 @@ T7869.hs:3:12: error: - • Couldn't match type ‘b’ with ‘b1’ - because type variable ‘b1’ would escape its scope - This (rigid, skolem) type variable is bound by + • Couldn't match type ‘b1’ with ‘b’ + ‘b1’ is a rigid type variable bound by an expression type signature: forall a1 b1. [a1] -> b1 at T7869.hs:3:20-27 + ‘b’ is a rigid type variable bound by + the inferred type of f :: [a] -> b + at T7869.hs:3:1-27 Expected type: [a1] -> b1 Actual type: [a] -> b • In the expression: f x diff --git a/testsuite/tests/typecheck/should_fail/T8030.stderr b/testsuite/tests/typecheck/should_fail/T8030.stderr index d9c34cd533..c1ff38b685 100644 --- a/testsuite/tests/typecheck/should_fail/T8030.stderr +++ b/testsuite/tests/typecheck/should_fail/T8030.stderr @@ -1,7 +1,7 @@ T8030.hs:9:3: error: • Couldn't match expected type ‘Pr a’ with actual type ‘Pr a0’ - NB: ‘Pr’ is a type function, and may not be injective + NB: ‘Pr’ is a non-injective type family The type variable ‘a0’ is ambiguous • In the ambiguity check for ‘op1’ To defer the ambiguity check to use sites, enable AllowAmbiguousTypes @@ -13,7 +13,7 @@ T8030.hs:10:3: error: • Couldn't match type ‘Pr a0’ with ‘Pr a’ Expected type: Pr a -> Pr a -> Pr a Actual type: Pr a0 -> Pr a0 -> Pr a0 - NB: ‘Pr’ is a type function, and may not be injective + NB: ‘Pr’ is a non-injective type family The type variable ‘a0’ is ambiguous • In the ambiguity check for ‘op2’ To defer the ambiguity check to use sites, enable AllowAmbiguousTypes diff --git a/testsuite/tests/typecheck/should_fail/T8034.stderr b/testsuite/tests/typecheck/should_fail/T8034.stderr index 247732a0bd..cce73f355a 100644 --- a/testsuite/tests/typecheck/should_fail/T8034.stderr +++ b/testsuite/tests/typecheck/should_fail/T8034.stderr @@ -3,7 +3,7 @@ T8034.hs:6:3: error: • Couldn't match type ‘F a0’ with ‘F a’ Expected type: F a -> F a Actual type: F a0 -> F a0 - NB: ‘F’ is a type function, and may not be injective + NB: ‘F’ is a non-injective type family The type variable ‘a0’ is ambiguous • In the ambiguity check for ‘foo’ To defer the ambiguity check to use sites, enable AllowAmbiguousTypes diff --git a/testsuite/tests/typecheck/should_fail/T8142.stderr b/testsuite/tests/typecheck/should_fail/T8142.stderr index aec8b3b55c..25d60d1aff 100644 --- a/testsuite/tests/typecheck/should_fail/T8142.stderr +++ b/testsuite/tests/typecheck/should_fail/T8142.stderr @@ -1,16 +1,24 @@ -T8142.hs:6:18: error: - • Couldn't match type ‘Nu g0’ with ‘Nu g’ - Expected type: Nu ((,) a) -> Nu g +T8142.hs:6:10: error: + • Couldn't match type ‘Nu ((,) a0)’ with ‘c -> f c’ + Expected type: (c -> f c) -> c -> f c Actual type: Nu ((,) a0) -> Nu g0 - NB: ‘Nu’ is a type function, and may not be injective - The type variable ‘g0’ is ambiguous - • In the ambiguity check for the inferred type for ‘h’ - To defer the ambiguity check to use sites, enable AllowAmbiguousTypes - When checking the inferred type - h :: forall a (g :: * -> *). Nu ((,) a) -> Nu g + The type variable ‘a0’ is ambiguous + • In the expression: h In an equation for ‘tracer’: tracer = h where h = (\ (_, b) -> ((outI . fmap h) b)) . out + • Relevant bindings include + tracer :: (c -> f c) -> c -> f c (bound at T8142.hs:6:1) + +T8142.hs:6:57: error: + • Couldn't match type ‘Nu ((,) a)’ with ‘g (Nu ((,) a))’ + Expected type: Nu ((,) a) -> (a, g (Nu ((,) a))) + Actual type: Nu ((,) a) -> (a, Nu ((,) a)) + • In the second argument of ‘(.)’, namely ‘out’ + In the expression: (\ (_, b) -> ((outI . fmap h) b)) . out + In an equation for ‘h’: h = (\ (_, b) -> ((outI . fmap h) b)) . out + • Relevant bindings include + h :: Nu ((,) a) -> Nu g (bound at T8142.hs:6:18) diff --git a/testsuite/tests/typecheck/should_fail/T8262.stderr b/testsuite/tests/typecheck/should_fail/T8262.stderr index d52ee31a31..fb0d17aef5 100644 --- a/testsuite/tests/typecheck/should_fail/T8262.stderr +++ b/testsuite/tests/typecheck/should_fail/T8262.stderr @@ -1,7 +1,11 @@ T8262.hs:5:15: error: • Couldn't match a lifted type with an unlifted type - When matching the kind of ‘GHC.Prim.Int#’ + When matching types + a :: * + GHC.Prim.Int# :: TYPE 'GHC.Types.IntRep • In the first argument of ‘Just’, namely ‘(1#)’ In the expression: Just (1#) In an equation for ‘foo’: foo x = Just (1#) + • Relevant bindings include + foo :: p -> Maybe a (bound at T8262.hs:5:1) diff --git a/testsuite/tests/typecheck/should_fail/T8603.hs b/testsuite/tests/typecheck/should_fail/T8603.hs index 90c1db3ad6..d17f246209 100644 --- a/testsuite/tests/typecheck/should_fail/T8603.hs +++ b/testsuite/tests/typecheck/should_fail/T8603.hs @@ -10,6 +10,10 @@ newtype RV a = RV { getPDF :: [(Rational,a)] } deriving (Show, Eq) instance Functor RV where fmap f = RV . map (\(x,y) -> (x, f y)) . getPDF +instance Applicative RV where + pure = return + (<*>) = ap + instance Monad RV where return x = RV [(1,x)] rv >>= f = RV $ @@ -29,4 +33,4 @@ testRVState1 = do prize <- lift uniform [1,2,3] return False --- lift :: (MonadTrans t, Monad m) => m a -> t m a
\ No newline at end of file +-- lift :: (MonadTrans t, Monad m) => m a -> t m a diff --git a/testsuite/tests/typecheck/should_fail/T8603.stderr b/testsuite/tests/typecheck/should_fail/T8603.stderr index d87bd635c4..d22d13f92b 100644 --- a/testsuite/tests/typecheck/should_fail/T8603.stderr +++ b/testsuite/tests/typecheck/should_fail/T8603.stderr @@ -1,19 +1,14 @@ -T8603.hs:13:10: error: - • No instance for (Applicative RV) - arising from the superclasses of an instance declaration - • In the instance declaration for ‘Monad RV’ - -T8603.hs:29:17: error: +T8603.hs:33:17: error: • Couldn't match type ‘RV a1’ with ‘StateT s RV a0’ Expected type: [Integer] -> StateT s RV a0 - Actual type: (->) ((->) [a1]) (RV a1) + Actual type: t0 ((->) [a1]) (RV a1) • The function ‘lift’ is applied to two arguments, - but its type ‘([a1] -> RV a1) -> (->) ((->) [a1]) (RV a1)’ + but its type ‘([a1] -> RV a1) -> t0 ((->) [a1]) (RV a1)’ has only one In a stmt of a 'do' block: prize <- lift uniform [1, 2, 3] In the expression: do prize <- lift uniform [1, 2, ....] return False • Relevant bindings include - testRVState1 :: RVState s Bool (bound at T8603.hs:28:1) + testRVState1 :: RVState s Bool (bound at T8603.hs:32:1) diff --git a/testsuite/tests/typecheck/should_fail/T8883.stderr b/testsuite/tests/typecheck/should_fail/T8883.stderr index 6f4946653b..d5a547db7b 100644 --- a/testsuite/tests/typecheck/should_fail/T8883.stderr +++ b/testsuite/tests/typecheck/should_fail/T8883.stderr @@ -4,5 +4,5 @@ T8883.hs:20:1: error: (Use FlexibleContexts to permit this) • When checking the inferred type fold :: forall a b. - (Regular a, Functor (PF a)) => + (Functor (PF a), Regular a) => (PF a b -> b) -> a -> b diff --git a/testsuite/tests/typecheck/should_fail/T8912.stderr b/testsuite/tests/typecheck/should_fail/T8912.stderr index bfe06c1511..7d6f37dca2 100644 --- a/testsuite/tests/typecheck/should_fail/T8912.stderr +++ b/testsuite/tests/typecheck/should_fail/T8912.stderr @@ -1,6 +1,4 @@ T8912.hs:7:10: error: • Illegal implicit parameter ‘?imp::Int’ - • In the context: ?imp::Int - While checking an instance declaration - In the instance declaration for ‘C [a]’ + • In the instance declaration for ‘C [a]’ diff --git a/testsuite/tests/typecheck/should_fail/T9196.stderr b/testsuite/tests/typecheck/should_fail/T9196.stderr index f843c70929..d6ca149f23 100644 --- a/testsuite/tests/typecheck/should_fail/T9196.stderr +++ b/testsuite/tests/typecheck/should_fail/T9196.stderr @@ -2,11 +2,11 @@ T9196.hs:4:6: error: • Illegal polymorphic type: forall a1. Eq a1 A constraint must be a monotype - • In the type signature: - f :: (forall a. Eq a) => a -> a + Perhaps you intended to use QuantifiedConstraints + • In the type signature: f :: (forall a. Eq a) => a -> a T9196.hs:7:6: error: • Illegal qualified type: Eq a => Ord a A constraint must be a monotype - • In the type signature: - g :: (Eq a => Ord a) => a -> a + Perhaps you intended to use QuantifiedConstraints + • In the type signature: g :: (Eq a => Ord a) => a -> a diff --git a/testsuite/tests/typecheck/should_fail/T9497d.stderr b/testsuite/tests/typecheck/should_fail/T9497d.stderr index 46121be1c1..fff9e2e6a8 100644 --- a/testsuite/tests/typecheck/should_fail/T9497d.stderr +++ b/testsuite/tests/typecheck/should_fail/T9497d.stderr @@ -5,3 +5,13 @@ T9497d.hs:2:8: error: • In the expression: _main In an equation for ‘main’: main = _main • Relevant bindings include main :: IO () (bound at T9497d.hs:2:1) + Valid hole fits include + main :: IO () (bound at T9497d.hs:2:1) + readLn :: forall a. Read a => IO a + with readLn @() + (imported from ‘Prelude’ at T9497d.hs:1:1 + (and originally defined in ‘System.IO’)) + mempty :: forall a. Monoid a => a + with mempty @(IO ()) + (imported from ‘Prelude’ at T9497d.hs:1:1 + (and originally defined in ‘GHC.Base’)) diff --git a/testsuite/tests/typecheck/should_fail/T9999.hs b/testsuite/tests/typecheck/should_fail/T9999.hs index 656e913043..8422df2b03 100644 --- a/testsuite/tests/typecheck/should_fail/T9999.hs +++ b/testsuite/tests/typecheck/should_fail/T9999.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE AutoDeriveTypeable, PolyKinds, TypeFamilies, StandaloneDeriving #-} +{-# LANGUAGE PolyKinds, TypeFamilies, StandaloneDeriving #-} module T9999 where diff --git a/testsuite/tests/typecheck/should_fail/TcCoercibleFail.stderr b/testsuite/tests/typecheck/should_fail/TcCoercibleFail.stderr index 8c0df32063..6d7e519d91 100644 --- a/testsuite/tests/typecheck/should_fail/TcCoercibleFail.stderr +++ b/testsuite/tests/typecheck/should_fail/TcCoercibleFail.stderr @@ -46,8 +46,7 @@ TcCoercibleFail.hs:30:9: error: TcCoercibleFail.hs:35:8: error: • Reduction stack overflow; size = 201 - When simplifying the following type: - Coercible (Fix (Either Int)) (Fix (Either Age)) + When simplifying the following type: Fix (Either Int) Use -freduction-depth=0 to disable this check (any upper bound you could choose might fail unpredictably with minor updates to GHC, so disabling the check is recommended if diff --git a/testsuite/tests/typecheck/should_fail/TcCoercibleFail2.stderr b/testsuite/tests/typecheck/should_fail/TcCoercibleFail2.stderr index b121f91c65..b8e4c6e5a8 100644 --- a/testsuite/tests/typecheck/should_fail/TcCoercibleFail2.stderr +++ b/testsuite/tests/typecheck/should_fail/TcCoercibleFail2.stderr @@ -1,5 +1,4 @@ TcCoercibleFail2.hs:5:10: error: - Illegal instance declaration for ‘Coercible () ()’ - Manual instances of this class are not permitted. - In the instance declaration for ‘Coercible () ()’ + • Class ‘Coercible’ does not support user-specified instances + • In the instance declaration for ‘Coercible () ()’ diff --git a/testsuite/tests/typecheck/should_fail/TcNoNullaryTC.stderr b/testsuite/tests/typecheck/should_fail/TcNoNullaryTC.stderr index 80f6ec4ec0..e41b8aa1bd 100644 --- a/testsuite/tests/typecheck/should_fail/TcNoNullaryTC.stderr +++ b/testsuite/tests/typecheck/should_fail/TcNoNullaryTC.stderr @@ -1,5 +1,5 @@ -TcNoNullaryTC.hs:3:1: - No parameters for class ‘A’ - (Use MultiParamTypeClasses to allow no-parameter classes) - In the class declaration for ‘A’ +TcNoNullaryTC.hs:3:1: error: + • No parameters for class ‘A’ + (Enable MultiParamTypeClasses to allow no-parameter classes) + • In the class declaration for ‘A’ diff --git a/testsuite/tests/typecheck/should_fail/TcStaticPointersFail02.stderr b/testsuite/tests/typecheck/should_fail/TcStaticPointersFail02.stderr index fd6be80c7e..c4d811c567 100644 --- a/testsuite/tests/typecheck/should_fail/TcStaticPointersFail02.stderr +++ b/testsuite/tests/typecheck/should_fail/TcStaticPointersFail02.stderr @@ -1,13 +1,13 @@ TcStaticPointersFail02.hs:9:6: error: - • No instance for (base-4.10.0.0:Data.Typeable.Internal.Typeable b) + • No instance for (base-4.12.0.0:Data.Typeable.Internal.Typeable b) arising from a static form • In the expression: static (undefined :: (forall a. a -> a) -> b) In an equation for ‘f1’: f1 = static (undefined :: (forall a. a -> a) -> b) TcStaticPointersFail02.hs:12:6: error: - • No instance for (base-4.10.0.0:Data.Typeable.Internal.Typeable + • No instance for (base-4.12.0.0:Data.Typeable.Internal.Typeable (Monad m => a -> m a)) arising from a static form (maybe you haven't applied a function to enough arguments?) diff --git a/testsuite/tests/typecheck/should_fail/VtaFail.stderr b/testsuite/tests/typecheck/should_fail/VtaFail.stderr index 17486dfefa..6cb1f442a7 100644 --- a/testsuite/tests/typecheck/should_fail/VtaFail.stderr +++ b/testsuite/tests/typecheck/should_fail/VtaFail.stderr @@ -6,12 +6,6 @@ VtaFail.hs:7:16: error: In an equation for ‘answer_nosig’: answer_nosig = pairup_nosig @Int @Bool 5 True -VtaFail.hs:12:26: error: - • No instance for (Num Bool) arising from a use of ‘addOne’ - • In the expression: addOne @Bool 5 - In an equation for ‘answer_constraint_fail’: - answer_constraint_fail = addOne @Bool 5 - VtaFail.hs:14:17: error: • Cannot apply expression of type ‘p0 -> p0’ to a visible type argument ‘Int’ @@ -31,6 +25,17 @@ VtaFail.hs:26:15: error: In the expression: first @Int F In an equation for ‘fInt’: fInt = first @Int F +VtaFail.hs:26:19: error: + • Couldn't match kind ‘*’ with ‘* -> *’ + When matching types + a1 :: * -> * + Int :: * + Expected type: First Int + Actual type: First a1 + • In the second argument of ‘first’, namely ‘F’ + In the expression: first @Int F + In an equation for ‘fInt’: fInt = first @Int F + VtaFail.hs:33:18: error: • Couldn't match type ‘Int’ with ‘Bool’ Expected type: Proxy Bool @@ -45,6 +50,17 @@ VtaFail.hs:40:17: error: In the expression: too @Maybe T In an equation for ‘threeBad’: threeBad = too @Maybe T +VtaFail.hs:40:23: error: + • Couldn't match kind ‘*’ with ‘k0 -> *’ + When matching types + a0 :: * -> k0 -> * + Maybe :: * -> * + Expected type: Three Maybe + Actual type: Three a0 + • In the second argument of ‘too’, namely ‘T’ + In the expression: too @Maybe T + In an equation for ‘threeBad’: threeBad = too @Maybe T + VtaFail.hs:41:27: error: • Couldn't match type ‘Either’ with ‘(->)’ Expected type: Three (->) diff --git a/testsuite/tests/typecheck/should_fail/all.T b/testsuite/tests/typecheck/should_fail/all.T index 254e04b55d..274dcc669e 100644 --- a/testsuite/tests/typecheck/should_fail/all.T +++ b/testsuite/tests/typecheck/should_fail/all.T @@ -1,4 +1,4 @@ - +4607 test('tcfail001', normal, compile_fail, ['']) test('tcfail002', normal, compile_fail, ['']) test('tcfail003', normal, compile_fail, ['']) @@ -107,7 +107,7 @@ test('tcfail122', normal, compile_fail, ['']) test('tcfail123', normal, compile_fail, ['']) test('tcfail124', normal, compile, ['']) test('tcfail125', normal, compile_fail, ['']) -test('tcfail126', reqlib('mtl'), compile, ['']) +test('tcfail126', normal, compile, ['']) test('tcfail127', normal, compile_fail, ['']) test('tcfail128', normal, compile_fail, ['']) test('tcfail129', normal, compile_fail, ['']) @@ -149,7 +149,7 @@ test('tcfail162', normal, compile_fail, ['']) test('tcfail164', normal, compile_fail, ['']) test('tcfail165', normal, compile_fail, ['']) test('tcfail166', normal, compile_fail, ['']) -test('tcfail167', normal, compile_fail, ['']) +test('tcfail167', normal, compile_fail, ['-Werror']) test('tcfail168', normal, compile_fail, ['']) test('tcfail169', normal, compile_fail, ['']) test('tcfail170', normal, compile_fail, ['']) @@ -415,6 +415,7 @@ test('T12170a', normal, compile_fail, ['']) test('T12124', normal, compile_fail, ['']) test('T12589', normal, compile_fail, ['']) test('T12529', normal, compile_fail, ['']) +test('T12563', normal, compile_fail, ['']) test('T12648', normal, compile_fail, ['']) test('T12729', normal, compile_fail, ['']) test('T12785b', normal, compile_fail, ['']) @@ -429,7 +430,7 @@ test('T12947', normal, compile_fail, ['']) test('T12973', normal, compile_fail, ['']) test('StrictBinds', normal, compile_fail, ['']) test('T13068', [extra_files(['T13068.hs', 'T13068a.hs', 'T13068.hs-boot', 'T13068m.hs'])], multimod_compile_fail, ['T13068m', '']) -test('T13075', expect_broken(13075), compile_fail, ['']) +test('T13075', normal, compile_fail, ['']) test('T13105', normal, compile_fail, ['']) test('LevPolyBounded', normal, compile_fail, ['']) test('T13487', normal, compile, ['']) @@ -446,3 +447,39 @@ test('T13677', normal, compile_fail, ['']) test('T13821A', expect_broken(13821), run_command, ['$MAKE -s --no-print-directory T13821A']) test('T13821B', expect_broken(13821), backpack_typecheck_fail, ['']) test('T13983', normal, compile_fail, ['']) +test('T13530', normal, compile_fail, ['']) +test('T12373', normal, compile_fail, ['']) +test('T13610', normal, compile_fail, ['']) +test('T11672', normal, compile_fail, ['']) +test('T13819', normal, compile_fail, ['']) +test('T13902', normal, compile_fail, ['']) +test('T14000', normal, compile_fail, ['']) +test('T14055', normal, compile_fail, ['']) +test('T13909', normal, compile_fail, ['']) +test('T13929', normal, compile_fail, ['']) +test('T14048a', normal, compile_fail, ['']) +test('T14048b', normal, compile_fail, ['']) +test('T14048c', normal, compile_fail, ['']) +test('T14232', normal, compile_fail, ['']) +test('T14325', normal, compile_fail, ['']) +test('T14350', normal, compile_fail, ['']) +test('T14390', normal, compile_fail, ['']) +test('MissingExportList03', normal, compile_fail, ['']) +test('T14618', normal, compile_fail, ['']) +test('T14607', normal, compile, ['']) +test('T14605', normal, compile_fail, ['']) +test('T14761a', normal, compile_fail, ['']) +test('T14761b', normal, compile_fail, ['']) +test('T14884', normal, compile_fail, ['']) +test('T14904a', normal, compile_fail, ['']) +test('T14904b', normal, compile_fail, ['']) +test('T15067', normal, compile_fail, ['']) +test('T15330', normal, compile_fail, ['']) +test('T15361', normal, compile_fail, ['']) +test('T15438', normal, compile_fail, ['']) +test('T15515', normal, compile_fail, ['']) +test('T15523', normal, compile_fail, ['-O']) +test('T15527', normal, compile_fail, ['']) +test('T15552', normal, compile, ['']) +test('T15552a', normal, compile_fail, ['']) +test('T15629', normal, compile_fail, ['']) diff --git a/testsuite/tests/typecheck/should_fail/fd-loop.stderr b/testsuite/tests/typecheck/should_fail/fd-loop.stderr index f0f11f58c1..86a70f5b76 100644 --- a/testsuite/tests/typecheck/should_fail/fd-loop.stderr +++ b/testsuite/tests/typecheck/should_fail/fd-loop.stderr @@ -1,12 +1,6 @@ fd-loop.hs:12:10: error: • Variable ‘b’ occurs more often - in the constraint ‘C a b’ than in the instance head - (Use UndecidableInstances to permit this) - • In the instance declaration for ‘Eq (T a)’ - -fd-loop.hs:12:10: error: - • Variable ‘b’ occurs more often - in the constraint ‘Eq b’ than in the instance head + in the constraint ‘C a b’ than in the instance head ‘Eq (T a)’ (Use UndecidableInstances to permit this) • In the instance declaration for ‘Eq (T a)’ diff --git a/testsuite/tests/typecheck/should_fail/tcfail008.stderr b/testsuite/tests/typecheck/should_fail/tcfail008.stderr index d84c3b90e3..1e7bc19585 100644 --- a/testsuite/tests/typecheck/should_fail/tcfail008.stderr +++ b/testsuite/tests/typecheck/should_fail/tcfail008.stderr @@ -1,21 +1,22 @@ tcfail008.hs:3:5: error: - Ambiguous type variable ‘a0’ arising from the literal ‘1’ - prevents the constraint ‘(Num a0)’ from being solved. - Relevant bindings include o :: [a0] (bound at tcfail008.hs:3:1) - Probable fix: use a type annotation to specify what ‘a0’ should be. - These potential instances exist: - instance Num Integer -- Defined in ‘GHC.Num’ - instance Num Double -- Defined in ‘GHC.Float’ - instance Num Float -- Defined in ‘GHC.Float’ - ...plus two others - (use -fprint-potential-instances to see them all) - In the first argument of ‘(:)’, namely ‘1’ - In the expression: 1 : 2 - In an equation for ‘o’: o = 1 : 2 + • Ambiguous type variable ‘a0’ arising from the literal ‘1’ + prevents the constraint ‘(Num a0)’ from being solved. + Relevant bindings include o :: [a0] (bound at tcfail008.hs:3:1) + Probable fix: use a type annotation to specify what ‘a0’ should be. + These potential instances exist: + instance Num Integer -- Defined in ‘GHC.Num’ + instance Num Double -- Defined in ‘GHC.Float’ + instance Num Float -- Defined in ‘GHC.Float’ + ...plus two others + ...plus one instance involving out-of-scope types + (use -fprint-potential-instances to see them all) + • In the first argument of ‘(:)’, namely ‘1’ + In the expression: 1 : 2 + In an equation for ‘o’: o = 1 : 2 tcfail008.hs:3:7: error: - No instance for (Num [a0]) arising from the literal ‘2’ - In the second argument of ‘(:)’, namely ‘2’ - In the expression: 1 : 2 - In an equation for ‘o’: o = 1 : 2 + • No instance for (Num [a0]) arising from the literal ‘2’ + • In the second argument of ‘(:)’, namely ‘2’ + In the expression: 1 : 2 + In an equation for ‘o’: o = 1 : 2 diff --git a/testsuite/tests/typecheck/should_fail/tcfail057.stderr b/testsuite/tests/typecheck/should_fail/tcfail057.stderr index 945c81c1cd..9ddffeb28b 100644 --- a/testsuite/tests/typecheck/should_fail/tcfail057.stderr +++ b/testsuite/tests/typecheck/should_fail/tcfail057.stderr @@ -1,5 +1,13 @@ tcfail057.hs:5:7: error: • Expected a type, but ‘RealFrac a’ has kind ‘Constraint’ - • In the type signature: - f :: (RealFrac a) -> a -> a + • In the type signature: f :: (RealFrac a) -> a -> a + +tcfail057.hs:6:7: error: + • Couldn't match expected type ‘a -> a’ + with actual type ‘RealFrac a’ + • In the expression: x + In an equation for ‘f’: f x = x + • Relevant bindings include + x :: RealFrac a (bound at tcfail057.hs:6:3) + f :: RealFrac a => a -> a (bound at tcfail057.hs:6:1) diff --git a/testsuite/tests/typecheck/should_fail/tcfail058.stderr b/testsuite/tests/typecheck/should_fail/tcfail058.stderr index 478aa7f467..5150637cb9 100644 --- a/testsuite/tests/typecheck/should_fail/tcfail058.stderr +++ b/testsuite/tests/typecheck/should_fail/tcfail058.stderr @@ -2,5 +2,24 @@ tcfail058.hs:6:7: error: • Expecting one more argument to ‘Array a’ Expected a constraint, but ‘Array a’ has kind ‘* -> *’ - • In the type signature: - f :: (Array a) => a -> b + • In the type signature: f :: (Array a) => a -> b + +tcfail058.hs:7:7: error: + • Could not deduce: a ~ b + from the context: Array a + bound by the type signature for: + f :: forall a b. Array a => a -> b + at tcfail058.hs:6:1-24 + ‘a’ is a rigid type variable bound by + the type signature for: + f :: forall a b. Array a => a -> b + at tcfail058.hs:6:1-24 + ‘b’ is a rigid type variable bound by + the type signature for: + f :: forall a b. Array a => a -> b + at tcfail058.hs:6:1-24 + • In the expression: x + In an equation for ‘f’: f x = x + • Relevant bindings include + x :: a (bound at tcfail058.hs:7:3) + f :: a -> b (bound at tcfail058.hs:7:1) diff --git a/testsuite/tests/typecheck/should_fail/tcfail063.stderr b/testsuite/tests/typecheck/should_fail/tcfail063.stderr index 935390e436..7dd1e9ce02 100644 --- a/testsuite/tests/typecheck/should_fail/tcfail063.stderr +++ b/testsuite/tests/typecheck/should_fail/tcfail063.stderr @@ -2,5 +2,21 @@ tcfail063.hs:6:9: error: • Expecting one more argument to ‘Num’ Expected a constraint, but ‘Num’ has kind ‘* -> Constraint’ - • In the type signature: - moby :: Num => Int -> a -> Int + • In the type signature: moby :: Num => Int -> a -> Int + +tcfail063.hs:7:14: error: + • Could not deduce: a ~ Int + from the context: Num + bound by the type signature for: + moby :: forall a. Num => Int -> a -> Int + at tcfail063.hs:6:1-30 + ‘a’ is a rigid type variable bound by + the type signature for: + moby :: forall a. Num => Int -> a -> Int + at tcfail063.hs:6:1-30 + • In the second argument of ‘(+)’, namely ‘y’ + In the expression: x + y + In an equation for ‘moby’: moby x y = x + y + • Relevant bindings include + y :: a (bound at tcfail063.hs:7:8) + moby :: Int -> a -> Int (bound at tcfail063.hs:7:1) diff --git a/testsuite/tests/typecheck/should_fail/tcfail068.stderr b/testsuite/tests/typecheck/should_fail/tcfail068.stderr index bb3f9ddb53..299fc7b8a7 100644 --- a/testsuite/tests/typecheck/should_fail/tcfail068.stderr +++ b/testsuite/tests/typecheck/should_fail/tcfail068.stderr @@ -4,7 +4,7 @@ tcfail068.hs:14:9: error: ‘s1’ is a rigid type variable bound by a type expected by the context: forall s1. GHC.ST.ST s1 (IndTree s a) - at tcfail068.hs:(13,9)-(14,31) + at tcfail068.hs:(13,15)-(14,31) ‘s’ is a rigid type variable bound by the type signature for: itgen :: forall a s. @@ -23,48 +23,48 @@ tcfail068.hs:14:9: error: (bound at tcfail068.hs:12:1) tcfail068.hs:19:9: error: - • Couldn't match type ‘s’ with ‘s1’ + • Couldn't match type ‘s1’ with ‘s’ + ‘s1’ is a rigid type variable bound by + a type expected by the context: + forall s1. GHC.ST.ST s1 (IndTree s a) + at tcfail068.hs:(18,15)-(21,19) ‘s’ is a rigid type variable bound by the type signature for: itiap :: forall a s. Constructed a => (Int, Int) -> (a -> a) -> IndTree s a -> IndTree s a at tcfail068.hs:16:1-75 - ‘s1’ is a rigid type variable bound by - a type expected by the context: - forall s1. GHC.ST.ST s1 (IndTree s a) - at tcfail068.hs:(18,9)-(21,19) Expected type: GHC.ST.ST s1 (IndTree s a) Actual type: GHC.ST.ST s (IndTree s a) • In the first argument of ‘runST’, namely ‘(readSTArray arr i - >>= \ val -> writeSTArray arr i (f val) >> return arr)’ + >>= \ val -> writeSTArray arr i (f val) >> return arr)’ In the expression: runST (readSTArray arr i - >>= \ val -> writeSTArray arr i (f val) >> return arr) + >>= \ val -> writeSTArray arr i (f val) >> return arr) In an equation for ‘itiap’: itiap i f arr = runST (readSTArray arr i - >>= \ val -> writeSTArray arr i (f val) >> return arr) + >>= \ val -> writeSTArray arr i (f val) >> return arr) • Relevant bindings include arr :: IndTree s a (bound at tcfail068.hs:17:11) itiap :: (Int, Int) -> (a -> a) -> IndTree s a -> IndTree s a (bound at tcfail068.hs:17:1) tcfail068.hs:24:36: error: - • Couldn't match type ‘s’ with ‘s1’ + • Couldn't match type ‘s1’ with ‘s’ + ‘s1’ is a rigid type variable bound by + a type expected by the context: + forall s1. GHC.ST.ST s1 (IndTree s a) + at tcfail068.hs:24:35-46 ‘s’ is a rigid type variable bound by the type signature for: itrap :: forall a s. Constructed a => ((Int, Int), (Int, Int)) -> (a -> a) -> IndTree s a -> IndTree s a at tcfail068.hs:23:1-87 - ‘s1’ is a rigid type variable bound by - a type expected by the context: - forall s1. GHC.ST.ST s1 (IndTree s a) - at tcfail068.hs:24:29-46 Expected type: GHC.ST.ST s1 (IndTree s a) Actual type: GHC.ST.ST s (IndTree s a) • In the first argument of ‘runST’, namely ‘(itrap' i k)’ @@ -91,7 +91,11 @@ tcfail068.hs:24:36: error: (bound at tcfail068.hs:24:1) tcfail068.hs:36:46: error: - • Couldn't match type ‘s’ with ‘s1’ + • Couldn't match type ‘s1’ with ‘s’ + ‘s1’ is a rigid type variable bound by + a type expected by the context: + forall s1. GHC.ST.ST s1 (c, IndTree s b) + at tcfail068.hs:36:45-63 ‘s’ is a rigid type variable bound by the type signature for: itrapstate :: forall b a c s. @@ -104,10 +108,6 @@ tcfail068.hs:36:46: error: -> IndTree s b -> (c, IndTree s b) at tcfail068.hs:(34,1)-(35,62) - ‘s1’ is a rigid type variable bound by - a type expected by the context: - forall s1. GHC.ST.ST s1 (c, IndTree s b) - at tcfail068.hs:36:40-63 Expected type: GHC.ST.ST s1 (c, IndTree s b) Actual type: GHC.ST.ST s (c, IndTree s b) • In the first argument of ‘runST’, namely ‘(itrapstate' i k s)’ diff --git a/testsuite/tests/typecheck/should_fail/tcfail070.stderr b/testsuite/tests/typecheck/should_fail/tcfail070.stderr index 0219626375..3f7bc90d8a 100644 --- a/testsuite/tests/typecheck/should_fail/tcfail070.stderr +++ b/testsuite/tests/typecheck/should_fail/tcfail070.stderr @@ -1,6 +1,5 @@ tcfail070.hs:15:15: error: - • Expecting one fewer arguments to ‘[Int]’ - Expected kind ‘* -> k0’, but ‘[Int]’ has kind ‘*’ + • Expected kind ‘* -> k0’, but ‘[Int]’ has kind ‘*’ • In the type ‘([Int] Bool)’ In the type declaration for ‘State’ diff --git a/testsuite/tests/typecheck/should_fail/tcfail072.stderr b/testsuite/tests/typecheck/should_fail/tcfail072.stderr index 15c4556480..c3fdb254d0 100644 --- a/testsuite/tests/typecheck/should_fail/tcfail072.stderr +++ b/testsuite/tests/typecheck/should_fail/tcfail072.stderr @@ -9,10 +9,10 @@ tcfail072.hs:23:13: error: These potential instances exist: instance Ord Ordering -- Defined in ‘GHC.Classes’ instance Ord Integer - -- Defined in ‘integer-gmp-1.0.0.1:GHC.Integer.Type’ - instance Ord a => Ord (Maybe a) -- Defined in ‘GHC.Base’ - ...plus 22 others - ...plus two instances involving out-of-scope types + -- Defined in ‘integer-gmp-1.0.1.0:GHC.Integer.Type’ + instance Ord () -- Defined in ‘GHC.Classes’ + ...plus 21 others + ...plus three instances involving out-of-scope types (use -fprint-potential-instances to see them all) • In the expression: g A In an equation for ‘g’: g (B _ _) = g A diff --git a/testsuite/tests/typecheck/should_fail/tcfail076.stderr b/testsuite/tests/typecheck/should_fail/tcfail076.stderr index 546715aa4a..52fcebb927 100644 --- a/testsuite/tests/typecheck/should_fail/tcfail076.stderr +++ b/testsuite/tests/typecheck/should_fail/tcfail076.stderr @@ -1,14 +1,14 @@ tcfail076.hs:18:82: error: - • Couldn't match type ‘res’ with ‘res1’ - ‘res’ is a rigid type variable bound by - a type expected by the context: - forall res. (a -> m res) -> m res - at tcfail076.hs:18:28-96 + • Couldn't match type ‘res1’ with ‘res’ ‘res1’ is a rigid type variable bound by a type expected by the context: forall res1. (b -> m res1) -> m res1 - at tcfail076.hs:18:64-88 + at tcfail076.hs:18:71-88 + ‘res’ is a rigid type variable bound by + a type expected by the context: + forall res. (a -> m res) -> m res + at tcfail076.hs:18:35-96 Expected type: m res1 Actual type: m res • In the expression: cont a diff --git a/testsuite/tests/typecheck/should_fail/tcfail078.stderr b/testsuite/tests/typecheck/should_fail/tcfail078.stderr index 8a94f7c4e4..014d589bf6 100644 --- a/testsuite/tests/typecheck/should_fail/tcfail078.stderr +++ b/testsuite/tests/typecheck/should_fail/tcfail078.stderr @@ -1,6 +1,4 @@ tcfail078.hs:5:6: error: - • Expecting one fewer arguments to ‘Integer’ - Expected kind ‘* -> Constraint’, but ‘Integer’ has kind ‘*’ - • In the type signature: - f :: Integer i => i + • Expected kind ‘* -> Constraint’, but ‘Integer’ has kind ‘*’ + • In the type signature: f :: Integer i => i diff --git a/testsuite/tests/typecheck/should_fail/tcfail082.stderr b/testsuite/tests/typecheck/should_fail/tcfail082.stderr index 841b5c82f6..31317b2c42 100644 --- a/testsuite/tests/typecheck/should_fail/tcfail082.stderr +++ b/testsuite/tests/typecheck/should_fail/tcfail082.stderr @@ -1,12 +1,12 @@ tcfail082.hs:2:1: error: Could not find module ‘Data82’ - Use -v to see a list of the files searched for. + Use -v (or `:set -v` in ghci) to see a list of the files searched for. tcfail082.hs:3:1: error: Could not find module ‘Inst82_1’ - Use -v to see a list of the files searched for. + Use -v (or `:set -v` in ghci) to see a list of the files searched for. tcfail082.hs:4:1: error: Could not find module ‘Inst82_2’ - Use -v to see a list of the files searched for. + Use -v (or `:set -v` in ghci) to see a list of the files searched for. diff --git a/testsuite/tests/typecheck/should_fail/tcfail090.stderr b/testsuite/tests/typecheck/should_fail/tcfail090.stderr index 662d7da804..efb81e8ee6 100644 --- a/testsuite/tests/typecheck/should_fail/tcfail090.stderr +++ b/testsuite/tests/typecheck/should_fail/tcfail090.stderr @@ -1,6 +1,8 @@ tcfail090.hs:11:9: error: • Couldn't match a lifted type with an unlifted type - When matching the kind of ‘ByteArray#’ + When matching types + a0 :: * + ByteArray# :: TYPE 'UnliftedRep • In the expression: my_undefined In an equation for ‘die’: die _ = my_undefined diff --git a/testsuite/tests/typecheck/should_fail/tcfail099.stderr b/testsuite/tests/typecheck/should_fail/tcfail099.stderr index bc30866ec2..a04920fb39 100644 --- a/testsuite/tests/typecheck/should_fail/tcfail099.stderr +++ b/testsuite/tests/typecheck/should_fail/tcfail099.stderr @@ -1,11 +1,13 @@ tcfail099.hs:9:20: error: • Couldn't match expected type ‘a’ with actual type ‘p’ - because type variable ‘a’ would escape its scope - This (rigid, skolem) type variable is bound by + ‘a’ is a rigid type variable bound by a pattern with constructor: C :: forall a. (a -> Int) -> DS, in an equation for ‘call’ at tcfail099.hs:9:7-9 + ‘p’ is a rigid type variable bound by + the inferred type of call :: DS -> p -> Int + at tcfail099.hs:9:1-22 • In the first argument of ‘f’, namely ‘arg’ In the expression: f arg In an equation for ‘call’: call (C f) arg = f arg diff --git a/testsuite/tests/typecheck/should_fail/tcfail103.stderr b/testsuite/tests/typecheck/should_fail/tcfail103.stderr index ba0694b117..2192d8a7f6 100644 --- a/testsuite/tests/typecheck/should_fail/tcfail103.stderr +++ b/testsuite/tests/typecheck/should_fail/tcfail103.stderr @@ -1,14 +1,14 @@ tcfail103.hs:15:13: error: - • Couldn't match type ‘t’ with ‘s’ - ‘t’ is a rigid type variable bound by - the type signature for: - f :: forall t. ST t Int - at tcfail103.hs:10:1-12 + • Couldn't match type ‘s’ with ‘t’ ‘s’ is a rigid type variable bound by the type signature for: g :: forall s. ST s Int at tcfail103.hs:13:9-21 + ‘t’ is a rigid type variable bound by + the type signature for: + f :: forall t. ST t Int + at tcfail103.hs:10:1-12 Expected type: ST s Int Actual type: ST t Int • In the expression: readSTRef v diff --git a/testsuite/tests/typecheck/should_fail/tcfail108.stderr b/testsuite/tests/typecheck/should_fail/tcfail108.stderr index ce07df62d9..4096ad36c6 100644 --- a/testsuite/tests/typecheck/should_fail/tcfail108.stderr +++ b/testsuite/tests/typecheck/should_fail/tcfail108.stderr @@ -1,6 +1,7 @@ tcfail108.hs:7:10: error: • Variable ‘f’ occurs more often - in the constraint ‘Eq (f (Rec f))’ than in the instance head + in the constraint ‘Eq (f (Rec f))’ + than in the instance head ‘Eq (Rec f)’ (Use UndecidableInstances to permit this) • In the instance declaration for ‘Eq (Rec f)’ diff --git a/testsuite/tests/typecheck/should_fail/tcfail113.stderr b/testsuite/tests/typecheck/should_fail/tcfail113.stderr index 410ce3daac..80c97d2737 100644 --- a/testsuite/tests/typecheck/should_fail/tcfail113.stderr +++ b/testsuite/tests/typecheck/should_fail/tcfail113.stderr @@ -2,17 +2,34 @@ tcfail113.hs:12:7: error: • Expecting one more argument to ‘Maybe’ Expected a type, but ‘Maybe’ has kind ‘* -> *’ - • In the type signature: - f :: [Maybe] + • In the type signature: f :: [Maybe] + +tcfail113.hs:13:1: error: + • Couldn't match expected type ‘[Maybe]’ + with actual type ‘p1 -> p1’ + • The equation(s) for ‘f’ have one argument, + but its type ‘[Maybe]’ has none + • Relevant bindings include + f :: [Maybe] (bound at tcfail113.hs:13:1) tcfail113.hs:15:8: error: • Expected kind ‘* -> *’, but ‘Int’ has kind ‘*’ • In the first argument of ‘T’, namely ‘Int’ - In the type signature: - g :: T Int + In the type signature: g :: T Int + +tcfail113.hs:16:1: error: + • Couldn't match expected type ‘T Int’ with actual type ‘p0 -> p0’ + • The equation(s) for ‘g’ have one argument, + but its type ‘T Int’ has none + • Relevant bindings include g :: T Int (bound at tcfail113.hs:16:1) tcfail113.hs:18:6: error: - • Expecting one fewer arguments to ‘Int’ - Expected kind ‘* -> *’, but ‘Int’ has kind ‘*’ - • In the type signature: - h :: Int Int + • Expected kind ‘* -> *’, but ‘Int’ has kind ‘*’ + • In the type signature: h :: Int Int + +tcfail113.hs:19:1: error: + • Couldn't match type ‘Int’ with ‘(->) Int’ + Expected type: Int Int + Actual type: Int -> Int + • The equation(s) for ‘h’ have one argument, + but its type ‘Int Int’ has none diff --git a/testsuite/tests/typecheck/should_fail/tcfail122.stderr b/testsuite/tests/typecheck/should_fail/tcfail122.stderr index a6fbc86c49..0ac1419e7d 100644 --- a/testsuite/tests/typecheck/should_fail/tcfail122.stderr +++ b/testsuite/tests/typecheck/should_fail/tcfail122.stderr @@ -1,7 +1,11 @@ tcfail122.hs:8:9: error: • Couldn't match kind ‘*’ with ‘* -> *’ - When matching the kind of ‘a’ + When matching types + c0 :: (* -> *) -> * + a :: * -> * + Expected type: a b + Actual type: c0 d0 • In the expression: undefined :: forall (c :: (* -> *) -> *) (d :: * -> *). c d In the expression: diff --git a/testsuite/tests/typecheck/should_fail/tcfail123.stderr b/testsuite/tests/typecheck/should_fail/tcfail123.stderr index 8f5f0a0afe..7089810e7c 100644 --- a/testsuite/tests/typecheck/should_fail/tcfail123.stderr +++ b/testsuite/tests/typecheck/should_fail/tcfail123.stderr @@ -1,7 +1,9 @@ tcfail123.hs:11:9: error: • Couldn't match a lifted type with an unlifted type - When matching the kind of ‘GHC.Prim.Int#’ + When matching types + p0 :: * + GHC.Prim.Int# :: TYPE 'GHC.Types.IntRep • In the first argument of ‘f’, namely ‘3#’ In the expression: f 3# In an equation for ‘h’: h v = f 3# diff --git a/testsuite/tests/typecheck/should_fail/tcfail132.stderr b/testsuite/tests/typecheck/should_fail/tcfail132.stderr index 3f8f226468..2e0a13c844 100644 --- a/testsuite/tests/typecheck/should_fail/tcfail132.stderr +++ b/testsuite/tests/typecheck/should_fail/tcfail132.stderr @@ -1,7 +1,6 @@ tcfail132.hs:17:37: error: - • Expecting one fewer arguments to ‘Object f' f t’ - Expected kind ‘* -> * -> * -> *’, + • Expected kind ‘* -> * -> * -> *’, but ‘Object f' f t’ has kind ‘* -> * -> *’ • In the first argument of ‘T’, namely ‘(Object f' f t)’ In the type ‘T (Object f' f t) (DUnit t)’ diff --git a/testsuite/tests/typecheck/should_fail/tcfail133.stderr b/testsuite/tests/typecheck/should_fail/tcfail133.stderr index a2b602cb98..bbaf091226 100644 --- a/testsuite/tests/typecheck/should_fail/tcfail133.stderr +++ b/testsuite/tests/typecheck/should_fail/tcfail133.stderr @@ -9,10 +9,10 @@ tcfail133.hs:68:7: error: These potential instances exist: instance Show Ordering -- Defined in ‘GHC.Show’ instance Show Integer -- Defined in ‘GHC.Show’ - instance (Show b, Show a, Digit b, Number a) => Show (a :@ b) + instance (Number a, Digit b, Show a, Show b) => Show (a :@ b) -- Defined at tcfail133.hs:11:54 ...plus 25 others - ...plus five instances involving out-of-scope types + ...plus 12 instances involving out-of-scope types (use -fprint-potential-instances to see them all) • In the expression: show $ add (One :@ Zero) (One :@ One) In an equation for ‘foo’: diff --git a/testsuite/tests/typecheck/should_fail/tcfail150.stderr b/testsuite/tests/typecheck/should_fail/tcfail150.stderr index 9d63f6318e..fe14a3ab1c 100644 --- a/testsuite/tests/typecheck/should_fail/tcfail150.stderr +++ b/testsuite/tests/typecheck/should_fail/tcfail150.stderr @@ -2,7 +2,7 @@ tcfail150.hs:6:3: error: • Constraint ‘Eq a’ in the type of ‘op’ constrains only the class type variables - Use ConstrainedClassMethods to allow it + Enable ConstrainedClassMethods to allow it • When checking the class method: op :: forall a. (Foo a, Eq a) => a -> a In the class declaration for ‘Foo’ diff --git a/testsuite/tests/typecheck/should_fail/tcfail154.stderr b/testsuite/tests/typecheck/should_fail/tcfail154.stderr index 0b42e0dfc4..3e613201f7 100644 --- a/testsuite/tests/typecheck/should_fail/tcfail154.stderr +++ b/testsuite/tests/typecheck/should_fail/tcfail154.stderr @@ -1,6 +1,6 @@ tcfail154.hs:12:10: error: • Variable ‘a’ occurs more often - in the constraint ‘C a a’ than in the instance head + in the constraint ‘C a a’ than in the instance head ‘Eq (T a)’ (Use UndecidableInstances to permit this) • In the instance declaration for ‘Eq (T a)’ diff --git a/testsuite/tests/typecheck/should_fail/tcfail157.stderr b/testsuite/tests/typecheck/should_fail/tcfail157.stderr index edc0506460..4cb2af7e9f 100644 --- a/testsuite/tests/typecheck/should_fail/tcfail157.stderr +++ b/testsuite/tests/typecheck/should_fail/tcfail157.stderr @@ -1,12 +1,7 @@ tcfail157.hs:27:10: error: • Variable ‘b’ occurs more often - in the constraint ‘E m a b’ than in the instance head - (Use UndecidableInstances to permit this) - • In the instance declaration for ‘Foo m (a -> ())’ - -tcfail157.hs:27:10: error: - • Variable ‘b’ occurs more often - in the constraint ‘Foo m b’ than in the instance head + in the constraint ‘E m a b’ + than in the instance head ‘Foo m (a -> ())’ (Use UndecidableInstances to permit this) • In the instance declaration for ‘Foo m (a -> ())’ diff --git a/testsuite/tests/typecheck/should_fail/tcfail158.stderr b/testsuite/tests/typecheck/should_fail/tcfail158.stderr index 12f8a4e8df..995be74380 100644 --- a/testsuite/tests/typecheck/should_fail/tcfail158.stderr +++ b/testsuite/tests/typecheck/should_fail/tcfail158.stderr @@ -1,6 +1,3 @@ -tcfail158.hs:14:19: error: - • Expecting one more argument to ‘Val v’ - Expected a type, but ‘Val v’ has kind ‘* -> *’ - • In the type signature: - bar :: forall v. Val v +tcfail158.hs:1:1: error: + The IO action ‘main’ is not defined in module ‘Main’ diff --git a/testsuite/tests/typecheck/should_fail/tcfail160.stderr b/testsuite/tests/typecheck/should_fail/tcfail160.stderr index 46a7640cf9..400b2bf5a4 100644 --- a/testsuite/tests/typecheck/should_fail/tcfail160.stderr +++ b/testsuite/tests/typecheck/should_fail/tcfail160.stderr @@ -2,5 +2,10 @@ tcfail160.hs:7:8: error: • Expected kind ‘* -> *’, but ‘Int’ has kind ‘*’ • In the first argument of ‘T’, namely ‘Int’ - In the type signature: - g :: T Int + In the type signature: g :: T Int + +tcfail160.hs:8:1: error: + • Couldn't match expected type ‘T Int’ with actual type ‘p0 -> p0’ + • The equation(s) for ‘g’ have one argument, + but its type ‘T Int’ has none + • Relevant bindings include g :: T Int (bound at tcfail160.hs:8:1) diff --git a/testsuite/tests/typecheck/should_fail/tcfail161.stderr b/testsuite/tests/typecheck/should_fail/tcfail161.stderr index ce783bb5ab..89042d1d20 100644 --- a/testsuite/tests/typecheck/should_fail/tcfail161.stderr +++ b/testsuite/tests/typecheck/should_fail/tcfail161.stderr @@ -2,5 +2,12 @@ tcfail161.hs:5:7: error: • Expecting one more argument to ‘Maybe’ Expected a type, but ‘Maybe’ has kind ‘* -> *’ - • In the type signature: - f :: [Maybe] + • In the type signature: f :: [Maybe] + +tcfail161.hs:6:1: error: + • Couldn't match expected type ‘[Maybe]’ + with actual type ‘p0 -> p0’ + • The equation(s) for ‘f’ have one argument, + but its type ‘[Maybe]’ has none + • Relevant bindings include + f :: [Maybe] (bound at tcfail161.hs:6:1) diff --git a/testsuite/tests/typecheck/should_fail/tcfail167.stderr b/testsuite/tests/typecheck/should_fail/tcfail167.stderr index 3700a7656c..8ca5dc9b80 100644 --- a/testsuite/tests/typecheck/should_fail/tcfail167.stderr +++ b/testsuite/tests/typecheck/should_fail/tcfail167.stderr @@ -1,5 +1,9 @@ -tcfail167.hs:14:14: error: +tcfail167.hs:14:1: error: [-Woverlapping-patterns (in -Wdefault), -Werror=overlapping-patterns] + Pattern match is redundant + In an equation for ‘inaccessible’: inaccessible C2 = ... + +tcfail167.hs:14:14: error: [-Winaccessible-code (in -Wdefault), -Werror=inaccessible-code] • Couldn't match type ‘Char’ with ‘Float’ Inaccessible code in a pattern with constructor: C2 :: T Float, diff --git a/testsuite/tests/typecheck/should_fail/tcfail174.stderr b/testsuite/tests/typecheck/should_fail/tcfail174.stderr index e8073887ac..724535145c 100644 --- a/testsuite/tests/typecheck/should_fail/tcfail174.stderr +++ b/testsuite/tests/typecheck/should_fail/tcfail174.stderr @@ -7,11 +7,13 @@ tcfail174.hs:9:5: error: In an equation for ‘g’: g = Base id tcfail174.hs:16:14: error: - • Couldn't match type ‘a’ with ‘a1’ - because type variable ‘a1’ would escape its scope - This (rigid, skolem) type variable is bound by + • Couldn't match type ‘a1’ with ‘a’ + ‘a1’ is a rigid type variable bound by the type a -> a at tcfail174.hs:16:1-14 + ‘a’ is a rigid type variable bound by + the inferred type of h1 :: Capture a + at tcfail174.hs:16:1-14 Expected type: Capture (forall x. x -> a) Actual type: Capture (forall a. a -> a) • In the first argument of ‘Capture’, namely ‘g’ @@ -23,7 +25,8 @@ tcfail174.hs:16:14: error: tcfail174.hs:19:14: error: • Couldn't match type ‘a’ with ‘b’ ‘a’ is a rigid type variable bound by - the type a -> a at tcfail174.hs:1:1 + the type a -> a + at tcfail174.hs:1:1 ‘b’ is a rigid type variable bound by the type signature for: h2 :: forall b. Capture b diff --git a/testsuite/tests/typecheck/should_fail/tcfail181.stderr b/testsuite/tests/typecheck/should_fail/tcfail181.stderr index 3ab08676b5..9cbc04b3d0 100644 --- a/testsuite/tests/typecheck/should_fail/tcfail181.stderr +++ b/testsuite/tests/typecheck/should_fail/tcfail181.stderr @@ -11,7 +11,7 @@ tcfail181.hs:17:9: error: instance Monad Maybe -- Defined in ‘GHC.Base’ instance Monoid a => Monad ((,) a) -- Defined in ‘GHC.Base’ ...plus one other - ...plus one instance involving out-of-scope types + ...plus two instances involving out-of-scope types (use -fprint-potential-instances to see them all) • In the expression: foo In the expression: foo {bar = return True} diff --git a/testsuite/tests/typecheck/should_fail/tcfail182.stderr b/testsuite/tests/typecheck/should_fail/tcfail182.stderr index d5ba794a7b..35e2e2d2c9 100644 --- a/testsuite/tests/typecheck/should_fail/tcfail182.stderr +++ b/testsuite/tests/typecheck/should_fail/tcfail182.stderr @@ -3,7 +3,8 @@ tcfail182.hs:9:3: error: • Couldn't match expected type ‘Prelude.Maybe a’ with actual type ‘Maybe a0’ NB: ‘Maybe’ is defined at tcfail182.hs:6:1-18 - ‘Prelude.Maybe’ is defined in ‘GHC.Base’ in package ‘base-4.10.0.0’ + ‘Prelude.Maybe’ + is defined in ‘GHC.Maybe’ in package ‘base-4.12.0.0’ • In the pattern: Foo In an equation for ‘f’: f Foo = 3 • Relevant bindings include diff --git a/testsuite/tests/typecheck/should_fail/tcfail198.stderr b/testsuite/tests/typecheck/should_fail/tcfail198.stderr index e8c3852b1c..66c8438dc4 100644 --- a/testsuite/tests/typecheck/should_fail/tcfail198.stderr +++ b/testsuite/tests/typecheck/should_fail/tcfail198.stderr @@ -1,11 +1,13 @@ tcfail198.hs:6:36: error: • Couldn't match expected type ‘a1’ with actual type ‘a’ - because type variable ‘a1’ would escape its scope - This (rigid, skolem) type variable is bound by + ‘a1’ is a rigid type variable bound by an expression type signature: forall a1. a1 at tcfail198.hs:6:41 + ‘a’ is a rigid type variable bound by + the inferred type of f3 :: [a] -> [a] + at tcfail198.hs:6:1-44 • In the expression: x :: a In the second argument of ‘(++)’, namely ‘[x :: a]’ In the expression: xs ++ [x :: a] diff --git a/testsuite/tests/typecheck/should_fail/tcfail200.stderr b/testsuite/tests/typecheck/should_fail/tcfail200.stderr index 407265ee9d..fdd0e3c073 100644 --- a/testsuite/tests/typecheck/should_fail/tcfail200.stderr +++ b/testsuite/tests/typecheck/should_fail/tcfail200.stderr @@ -1,7 +1,11 @@ tcfail200.hs:5:15: error: • Couldn't match a lifted type with an unlifted type - When matching the kind of ‘GHC.Prim.Int#’ + When matching types + a1 :: * + GHC.Prim.Int# :: TYPE 'GHC.Types.IntRep • In the expression: 1# In the expression: (1#, 'c') In an equation for ‘x’: x = (1#, 'c') + • Relevant bindings include + x :: (a1, Char) (bound at tcfail200.hs:5:9) diff --git a/testsuite/tests/typecheck/should_fail/tcfail211.stderr b/testsuite/tests/typecheck/should_fail/tcfail211.stderr index 7a5053a092..fb1192b0ca 100644 --- a/testsuite/tests/typecheck/should_fail/tcfail211.stderr +++ b/testsuite/tests/typecheck/should_fail/tcfail211.stderr @@ -7,6 +7,4 @@ tcfail211.hs:5:1: error: tcfail211.hs:8:10: error: • Illegal implicit parameter ‘?imp::Int’ - • In the context: ?imp::Int - While checking an instance declaration - In the instance declaration for ‘D Int’ + • In the instance declaration for ‘D Int’ diff --git a/testsuite/tests/typecheck/should_fail/tcfail212.stderr b/testsuite/tests/typecheck/should_fail/tcfail212.stderr index 8eb7e6e57f..8ceab3e931 100644 --- a/testsuite/tests/typecheck/should_fail/tcfail212.stderr +++ b/testsuite/tests/typecheck/should_fail/tcfail212.stderr @@ -2,21 +2,31 @@ tcfail212.hs:10:7: error: • Expecting one more argument to ‘Maybe’ Expected a type, but ‘Maybe’ has kind ‘* -> *’ - • In the type signature: - f :: (Maybe, Either Int) + • In the type signature: f :: (Maybe, Either Int) tcfail212.hs:10:14: error: • Expecting one more argument to ‘Either Int’ Expected a type, but ‘Either Int’ has kind ‘* -> *’ - • In the type signature: - f :: (Maybe, Either Int) + • In the type signature: f :: (Maybe, Either Int) + +tcfail212.hs:11:6: error: + • Couldn't match expected type ‘Maybe’ + with actual type ‘Maybe Integer’ + • In the expression: Just 1 + In the expression: (Just 1, Left 1) + In an equation for ‘f’: f = (Just 1, Left 1) + +tcfail212.hs:11:14: error: + • Couldn't match expected type ‘Either Int’ + with actual type ‘Either Integer b0’ + • In the expression: Left 1 + In the expression: (Just 1, Left 1) + In an equation for ‘f’: f = (Just 1, Left 1) tcfail212.hs:13:7: error: • Expecting a lifted type, but ‘Int#’ is unlifted - • In the type signature: - g :: (Int#, Int#) + • In the type signature: g :: (Int#, Int#) tcfail212.hs:13:13: error: • Expecting a lifted type, but ‘Int#’ is unlifted - • In the type signature: - g :: (Int#, Int#) + • In the type signature: g :: (Int#, Int#) diff --git a/testsuite/tests/typecheck/should_fail/tcfail214.stderr b/testsuite/tests/typecheck/should_fail/tcfail214.stderr index c6a4387142..83fa344834 100644 --- a/testsuite/tests/typecheck/should_fail/tcfail214.stderr +++ b/testsuite/tests/typecheck/should_fail/tcfail214.stderr @@ -1,5 +1,5 @@ tcfail214.hs:9:10: error: - • The constraint ‘F a’ is no smaller than the instance head + • Illegal nested constraint ‘F a’ (Use UndecidableInstances to permit this) • In the instance declaration for ‘C [a]’ diff --git a/testsuite/tests/typecheck/should_run/EtaExpandLevPoly.hs b/testsuite/tests/typecheck/should_run/EtaExpandLevPoly.hs index e912411209..d57d2e1499 100644 --- a/testsuite/tests/typecheck/should_run/EtaExpandLevPoly.hs +++ b/testsuite/tests/typecheck/should_run/EtaExpandLevPoly.hs @@ -1,5 +1,5 @@ -{-# LANGUAGE UnboxedTuples, MagicHash, GADTs, TypeInType, ExplicitForAll #-} - +{-# LANGUAGE UnboxedTuples, MagicHash, GADTs, + DataKinds, PolyKinds, ExplicitForAll #-} module Main where diff --git a/testsuite/tests/typecheck/should_run/IPLocation.hs b/testsuite/tests/typecheck/should_run/IPLocation.hs index 75575e0d16..964728934e 100644 --- a/testsuite/tests/typecheck/should_run/IPLocation.hs +++ b/testsuite/tests/typecheck/should_run/IPLocation.hs @@ -29,9 +29,15 @@ f6 0 = putStrLn $ prettyCallStack ?loc f6 n = f6 (n-1) -- recursive functions add a SrcLoc for each recursive call +f7 :: IO () +f7 = putStrLn (prettyCallStack $ id (\_ -> callStack) ()) + -- shouldn't crash. See #14043. + +main :: IO () main = do f0 f1 f3 (\ () -> putStrLn $ prettyCallStack ?loc) f4 (\ () -> putStrLn $ prettyCallStack ?loc) f5 (\ () -> putStrLn $ prettyCallStack ?loc3) f6 5 + f7 diff --git a/testsuite/tests/typecheck/should_run/KindInvariant.script b/testsuite/tests/typecheck/should_run/KindInvariant.script index a993d515c5..34f6be361e 100644 --- a/testsuite/tests/typecheck/should_run/KindInvariant.script +++ b/testsuite/tests/typecheck/should_run/KindInvariant.script @@ -1,12 +1,12 @@ -:set -XTypeInType -XDataKinds -XKindSignatures -XMagicHash -XPolyKinds +:set -XDataKinds -XKindSignatures -XMagicHash -XPolyKinds :m + Data.Kind GHC.Exts data T (a :: k -> k') :kind T State# -data T (a :: * -> k') +data T (a :: Type -> k') :kind T State# -- this should fail -data T (a :: * -> *) +data T (a :: Type -> Type) :kind T State# diff --git a/testsuite/tests/typecheck/should_run/T11120.hs b/testsuite/tests/typecheck/should_run/T11120.hs index f42e8cd5c0..5b5d7f343c 100644 --- a/testsuite/tests/typecheck/should_run/T11120.hs +++ b/testsuite/tests/typecheck/should_run/T11120.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE TypeInType, MagicHash, DataKinds #-} +{-# LANGUAGE MagicHash, DataKinds #-} -- See also TypeOf.hs import GHC.Prim diff --git a/testsuite/tests/typecheck/should_run/T12809.hs b/testsuite/tests/typecheck/should_run/T12809.hs index 9f6da26d76..66031a5af7 100644 --- a/testsuite/tests/typecheck/should_run/T12809.hs +++ b/testsuite/tests/typecheck/should_run/T12809.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE TypeInType, ExplicitForAll, MagicHash, UnboxedTuples, +{-# LANGUAGE DataKinds, PolyKinds, ExplicitForAll, MagicHash, UnboxedTuples, TypeFamilies, GADTs #-} module Main where diff --git a/testsuite/tests/typecheck/should_run/T13435.hs b/testsuite/tests/typecheck/should_run/T13435.hs index 95ee946fa0..bc02f17b4c 100644 --- a/testsuite/tests/typecheck/should_run/T13435.hs +++ b/testsuite/tests/typecheck/should_run/T13435.hs @@ -1,4 +1,5 @@ -{-# Language FlexibleInstances, TypeFamilies, TypeInType, MagicHash #-} +{-# Language FlexibleInstances, TypeFamilies, + DataKinds, PolyKinds, MagicHash #-} module Main where diff --git a/testsuite/tests/typecheck/should_run/T13838.hs b/testsuite/tests/typecheck/should_run/T13838.hs new file mode 100644 index 0000000000..265fdb0986 --- /dev/null +++ b/testsuite/tests/typecheck/should_run/T13838.hs @@ -0,0 +1,6 @@ +{-# OPTIONS_GHC -fdefer-type-errors #-} + +module Main where + +main :: () -> () +main = undefined diff --git a/testsuite/tests/typecheck/should_run/T13838.stderr b/testsuite/tests/typecheck/should_run/T13838.stderr new file mode 100644 index 0000000000..b2129f7d13 --- /dev/null +++ b/testsuite/tests/typecheck/should_run/T13838.stderr @@ -0,0 +1,6 @@ +T13838.exe: T13838.hs:6:1: error: + • Couldn't match expected type ‘IO t0’ with actual type ‘() -> ()’ + • Probable cause: ‘main’ is applied to too few arguments + In the expression: main + When checking the type of the IO action ‘main’ +(deferred type error) diff --git a/testsuite/tests/typecheck/should_run/T14218.hs b/testsuite/tests/typecheck/should_run/T14218.hs new file mode 100644 index 0000000000..061700e083 --- /dev/null +++ b/testsuite/tests/typecheck/should_run/T14218.hs @@ -0,0 +1,34 @@ +{-# LANGUAGE ConstraintKinds #-} -- For 'C' +{-# LANGUAGE MultiParamTypeClasses #-} -- For nullary 'Trivial' class +{-# LANGUAGE ImplicitParams #-} +{-# OPTIONS_GHC -Wno-simplifiable-class-constraints #-} +module Main where + +import qualified GHC.Stack as Ghc + +class Trivial where +instance Trivial where + +type C = (Ghc.HasCallStack, Trivial) + +-- | Print the functions on the call stack. +callStack :: C => IO () +callStack = print $ map fst (Ghc.getCallStack Ghc.callStack) + +f :: C => a -> IO () +f x = callStack + +type C2 = (?x::Int, ?y::Int) + +h1 :: C2 => Int -> IO () +h1 v = print (?x+v) + +h2 :: C2 => Int -> IO () +h2 v = let ?x = 0 in h1 v + +main = do { let { ?x = 3; ?y = 4 } in h2 4 + -- Should print 4+0 = 4 + + ; f "ugh" + -- Should print @["callStack", "f"]@. + } diff --git a/testsuite/tests/typecheck/should_run/T14218.stdout b/testsuite/tests/typecheck/should_run/T14218.stdout new file mode 100644 index 0000000000..f446c88ee9 --- /dev/null +++ b/testsuite/tests/typecheck/should_run/T14218.stdout @@ -0,0 +1,2 @@ +4 +["callStack","f"] diff --git a/testsuite/tests/typecheck/should_run/T14236.hs b/testsuite/tests/typecheck/should_run/T14236.hs new file mode 100644 index 0000000000..c08682bc14 --- /dev/null +++ b/testsuite/tests/typecheck/should_run/T14236.hs @@ -0,0 +1,14 @@ +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE MagicHash #-} +import GHC.Exts +import Type.Reflection + +main = do + case typeRep @(Int -> Char) of + App a b -> print (a, b) + + case typeRep @(Int# -> Char) of + App a b -> print (a, b) + + case typeRep @(Int# -> Char) of + App a b -> print $ App a (typeRep @String) diff --git a/testsuite/tests/typecheck/should_run/T14236.stdout b/testsuite/tests/typecheck/should_run/T14236.stdout new file mode 100644 index 0000000000..a168ea8d04 --- /dev/null +++ b/testsuite/tests/typecheck/should_run/T14236.stdout @@ -0,0 +1,3 @@ +((->) 'LiftedRep 'LiftedRep Int,Char) +((->) 'IntRep 'LiftedRep Int#,Char) +Int# -> [Char] diff --git a/testsuite/tests/typecheck/should_run/T14925.hs b/testsuite/tests/typecheck/should_run/T14925.hs new file mode 100644 index 0000000000..ed57a82b9b --- /dev/null +++ b/testsuite/tests/typecheck/should_run/T14925.hs @@ -0,0 +1,6 @@ +import Data.Typeable + +data Ω = Ω + +main :: IO () +main = print $ typeOf Ω diff --git a/testsuite/tests/typecheck/should_run/T14925.stdout b/testsuite/tests/typecheck/should_run/T14925.stdout new file mode 100644 index 0000000000..6a44a9974b --- /dev/null +++ b/testsuite/tests/typecheck/should_run/T14925.stdout @@ -0,0 +1 @@ +Ω diff --git a/testsuite/tests/typecheck/should_run/T6117.hs b/testsuite/tests/typecheck/should_run/T6117.hs index 2fe9f29291..33e81c7b59 100644 --- a/testsuite/tests/typecheck/should_run/T6117.hs +++ b/testsuite/tests/typecheck/should_run/T6117.hs @@ -1,5 +1,7 @@ {-# LANGUAGE FlexibleContexts #-} +import Prelude hiding (Semigroup(..)) + {- [Summary of the program] Ring is defined as a subclass of Semigroup, inheriting multiplication. Additive is a wrapper that extracts the additive diff --git a/testsuite/tests/typecheck/should_run/T9497a-run.stderr b/testsuite/tests/typecheck/should_run/T9497a-run.stderr index 9a7ac000ec..6461d98b10 100644 --- a/testsuite/tests/typecheck/should_run/T9497a-run.stderr +++ b/testsuite/tests/typecheck/should_run/T9497a-run.stderr @@ -1,8 +1,18 @@ T9497a-run: T9497a-run.hs:2:8: error: - Found hole: _main :: IO () - Or perhaps ‘_main’ is mis-spelled, or not in scope - In the expression: _main - In an equation for ‘main’: main = _main - Relevant bindings include - main :: IO () (bound at T9497a-run.hs:2:1) + • Found hole: _main :: IO () + Or perhaps ‘_main’ is mis-spelled, or not in scope + • In the expression: _main + In an equation for ‘main’: main = _main + • Relevant bindings include + main :: IO () (bound at T9497a-run.hs:2:1) + Valid hole fits include + main :: IO () (bound at T9497a-run.hs:2:1) + readLn :: forall a. Read a => IO a + with readLn @() + (imported from ‘Prelude’ at T9497a-run.hs:1:1 + (and originally defined in ‘System.IO’)) + mempty :: forall a. Monoid a => a + with mempty @(IO ()) + (imported from ‘Prelude’ at T9497a-run.hs:1:1 + (and originally defined in ‘GHC.Base’)) (deferred type error) diff --git a/testsuite/tests/typecheck/should_run/T9497b-run.stderr b/testsuite/tests/typecheck/should_run/T9497b-run.stderr index 432b5fed2c..a73b71981c 100644 --- a/testsuite/tests/typecheck/should_run/T9497b-run.stderr +++ b/testsuite/tests/typecheck/should_run/T9497b-run.stderr @@ -1,8 +1,18 @@ T9497b-run: T9497b-run.hs:2:8: error: - Found hole: _main :: IO () - Or perhaps ‘_main’ is mis-spelled, or not in scope - In the expression: _main - In an equation for ‘main’: main = _main - Relevant bindings include - main :: IO () (bound at T9497b-run.hs:2:1) + • Found hole: _main :: IO () + Or perhaps ‘_main’ is mis-spelled, or not in scope + • In the expression: _main + In an equation for ‘main’: main = _main + • Relevant bindings include + main :: IO () (bound at T9497b-run.hs:2:1) + Valid hole fits include + main :: IO () (bound at T9497b-run.hs:2:1) + readLn :: forall a. Read a => IO a + with readLn @() + (imported from ‘Prelude’ at T9497b-run.hs:1:1 + (and originally defined in ‘System.IO’)) + mempty :: forall a. Monoid a => a + with mempty @(IO ()) + (imported from ‘Prelude’ at T9497b-run.hs:1:1 + (and originally defined in ‘GHC.Base’)) (deferred type error) diff --git a/testsuite/tests/typecheck/should_run/T9497c-run.stderr b/testsuite/tests/typecheck/should_run/T9497c-run.stderr index 61d8575d2c..8666900b4e 100644 --- a/testsuite/tests/typecheck/should_run/T9497c-run.stderr +++ b/testsuite/tests/typecheck/should_run/T9497c-run.stderr @@ -1,8 +1,18 @@ T9497c-run: T9497c-run.hs:2:8: error: - Found hole: _main :: IO () - Or perhaps ‘_main’ is mis-spelled, or not in scope - In the expression: _main - In an equation for ‘main’: main = _main - Relevant bindings include - main :: IO () (bound at T9497c-run.hs:2:1) + • Found hole: _main :: IO () + Or perhaps ‘_main’ is mis-spelled, or not in scope + • In the expression: _main + In an equation for ‘main’: main = _main + • Relevant bindings include + main :: IO () (bound at T9497c-run.hs:2:1) + Valid hole fits include + main :: IO () (bound at T9497c-run.hs:2:1) + readLn :: forall a. Read a => IO a + with readLn @() + (imported from ‘Prelude’ at T9497c-run.hs:1:1 + (and originally defined in ‘System.IO’)) + mempty :: forall a. Monoid a => a + with mempty @(IO ()) + (imported from ‘Prelude’ at T9497c-run.hs:1:1 + (and originally defined in ‘GHC.Base’)) (deferred type error) diff --git a/testsuite/tests/typecheck/should_run/TcTypeNatSimpleRun.hs b/testsuite/tests/typecheck/should_run/TcTypeNatSimpleRun.hs index fb1463cc86..c12d53cde6 100644 --- a/testsuite/tests/typecheck/should_run/TcTypeNatSimpleRun.hs +++ b/testsuite/tests/typecheck/should_run/TcTypeNatSimpleRun.hs @@ -1,6 +1,6 @@ {-# LANGUAGE DataKinds, TypeOperators, TypeFamilies #-} module Main(main) where -import GHC.TypeLits +import GHC.TypeLits as L import Data.Proxy -------------------------------------------------------------------------------- @@ -12,10 +12,10 @@ tsub _ _ = Proxy tsub2 :: Proxy (x + y) -> (Proxy x, Proxy y) tsub2 _ = (Proxy, Proxy) -tdiv :: Proxy (x * y) -> Proxy y -> Proxy x +tdiv :: Proxy (x L.* y) -> Proxy y -> Proxy x tdiv _ _ = Proxy -tdiv2 :: Proxy (x * y) -> (Proxy x, Proxy y) +tdiv2 :: Proxy (x L.* y) -> (Proxy x, Proxy y) tdiv2 _ = (Proxy, Proxy) troot :: Proxy (x ^ y) -> Proxy y -> Proxy x diff --git a/testsuite/tests/typecheck/should_run/TypeOf.hs b/testsuite/tests/typecheck/should_run/TypeOf.hs index 59ea6fdf0d..11601a9a89 100644 --- a/testsuite/tests/typecheck/should_run/TypeOf.hs +++ b/testsuite/tests/typecheck/should_run/TypeOf.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DataKinds, UnicodeSyntax #-} import Data.Typeable import GHC.Types diff --git a/testsuite/tests/typecheck/should_run/TypeOf.stdout b/testsuite/tests/typecheck/should_run/TypeOf.stdout index 6e9a28ed7c..912fe39a84 100644 --- a/testsuite/tests/typecheck/should_run/TypeOf.stdout +++ b/testsuite/tests/typecheck/should_run/TypeOf.stdout @@ -21,4 +21,4 @@ Proxy * * Proxy * * Proxy RuntimeRep 'LiftedRep Proxy (Nat,Symbol) ('(,) Nat Symbol 1 "hello") -Proxy (* -> * -> Constraint) (~~ * *) +Proxy (* -> * -> Constraint) ((~~) * *) diff --git a/testsuite/tests/typecheck/should_run/TypeRep.hs b/testsuite/tests/typecheck/should_run/TypeRep.hs index 002e4fbac0..43d774a6b5 100644 --- a/testsuite/tests/typecheck/should_run/TypeRep.hs +++ b/testsuite/tests/typecheck/should_run/TypeRep.hs @@ -1,13 +1,15 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE KindSignatures #-} {-# LANGUAGE ConstraintKinds #-} -{-# LANGUAGE TypeInType #-} +{-# LANGUAGE PolyKinds #-} {-# LANGUAGE UnboxedTuples #-} {-# LANGUAGE MagicHash #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE TypeOperators #-} +{-# LANGUAGE StarIsType #-} +{-# LANGUAGE UnicodeSyntax #-} import Data.Typeable import Data.Kind diff --git a/testsuite/tests/typecheck/should_run/Typeable1.stderr b/testsuite/tests/typecheck/should_run/Typeable1.stderr index 65f6fd4645..ec16681592 100644 --- a/testsuite/tests/typecheck/should_run/Typeable1.stderr +++ b/testsuite/tests/typecheck/should_run/Typeable1.stderr @@ -1,7 +1,6 @@ -Typeable1.hs:22:5: error: - • Couldn't match kind ‘* -> (* -> *) -> (* -> *) -> * -> *’ - with ‘forall k. (* -> *) -> (k -> *) -> k -> *’ +Typeable1.hs:22:5: error: [-Winaccessible-code (in -Wdefault), -Werror=inaccessible-code] + • Couldn't match type ‘ComposeK’ with ‘a3 b3’ Inaccessible code in a pattern with pattern synonym: App :: forall k2 (t :: k2). @@ -10,7 +9,7 @@ Typeable1.hs:22:5: error: (t ~ a b) => TypeRep a -> TypeRep b -> TypeRep t, in a pattern binding in - 'do' block + a 'do' block • In the pattern: App x y In a stmt of a 'do' block: App x y <- pure x In the expression: diff --git a/testsuite/tests/typecheck/should_run/all.T b/testsuite/tests/typecheck/should_run/all.T index 346c312649..a96c2b71c5 100755 --- a/testsuite/tests/typecheck/should_run/all.T +++ b/testsuite/tests/typecheck/should_run/all.T @@ -84,7 +84,7 @@ test('T3731', normal, compile_and_run, ['']) test('T3731-short', normal, compile_and_run, ['']) test('T3500a', normal, compile_and_run, ['']) test('T3500b', normal, compile_and_run, ['']) -test('T4809', reqlib('mtl'), compile_and_run, ['']) +test('T4809', normal, compile_and_run, ['']) test('T2722', normal, compile_and_run, ['']) test('mc17', normal, compile_and_run, ['']) test('T5759', normal, compile_and_run, ['']) @@ -114,12 +114,25 @@ test('TypeOf', normal, compile_and_run, ['']) test('TypeRep', normal, compile_and_run, ['']) test('T11120', normal, compile_and_run, ['']) test('KindInvariant', normal, ghci_script, ['KindInvariant.script']) -test('StrictPats', normal, compile_and_run, ['']) -test('T12809', normal, compile_and_run, ['']) -test('EtaExpandLevPoly', normal, compile_and_run, ['']) + +# We omit the ghci way in these 3 tests because they use +# unboxed sums and ghci does not support those yet. +test('StrictPats', omit_ways(['ghci']), compile_and_run, ['']) +test('T12809', omit_ways(['ghci']), compile_and_run, ['']) +test('EtaExpandLevPoly', [ omit_ways(['ghci']) + # triggers a core lint error in profiled ways + , expect_broken_for(15066, ['profasm', 'profthreaded']) + ], compile_and_run, ['']) + test('TestTypeableBinary', normal, compile_and_run, ['']) -test('Typeable1', normal, compile_fail, ['']) +test('Typeable1', normal, compile_fail, ['-Werror']) test('TypeableEq', normal, compile_and_run, ['']) test('T13435', normal, compile_and_run, ['']) test('T11715', exit_code(1), compile_and_run, ['']) test('T13594a', normal, ghci_script, ['T13594a.script']) + +# GHCi exits with code zero due to deferred type errors +test('T13838', [exit_code(1), omit_ways(['ghci'])], compile_and_run, ['-fdefer-type-errors']) +test('T14218', normal, compile_and_run, ['']) +test('T14236', normal, compile_and_run, ['']) +test('T14925', normal, compile_and_run, ['']) diff --git a/testsuite/tests/typecheck/should_run/tcrun045.stderr b/testsuite/tests/typecheck/should_run/tcrun045.stderr index f6b1652e5b..feabc4bad4 100644 --- a/testsuite/tests/typecheck/should_run/tcrun045.stderr +++ b/testsuite/tests/typecheck/should_run/tcrun045.stderr @@ -1,9 +1,7 @@ tcrun045.hs:11:10: error: • Illegal implicit parameter ‘?imp::Int’ - • In the context: ?imp::Int - While checking an instance declaration - In the instance declaration for ‘C Int’ + • In the instance declaration for ‘C Int’ tcrun045.hs:24:1: error: • Illegal implicit parameter ‘?imp::Int’ @@ -13,6 +11,4 @@ tcrun045.hs:24:1: error: tcrun045.hs:27:10: error: • Illegal implicit parameter ‘?imp::Int’ - • In the context: ?imp::Int - While checking an instance declaration - In the instance declaration for ‘D Int’ + • In the instance declaration for ‘D Int’ diff --git a/testsuite/tests/unboxedsums/T12711.script b/testsuite/tests/unboxedsums/T12711.script index 898fdc106a..7af8674ed0 100644 --- a/testsuite/tests/unboxedsums/T12711.script +++ b/testsuite/tests/unboxedsums/T12711.script @@ -1,2 +1,2 @@ -:set -XUnboxedSums +:set -XUnboxedSums -XPartialTypeSignatures -fno-warn-partial-type-signatures :kind (# _ | _ #) diff --git a/testsuite/tests/unboxedsums/T12711.stdout b/testsuite/tests/unboxedsums/T12711.stdout index 7a623a3bd6..54af3fdfa6 100644 --- a/testsuite/tests/unboxedsums/T12711.stdout +++ b/testsuite/tests/unboxedsums/T12711.stdout @@ -1,2 +1,2 @@ (# _ | _ #) :: TYPE - ('GHC.Types.SumRep '['GHC.Types.LiftedRep, 'GHC.Types.LiftedRep]) + ('GHC.Types.SumRep '[ 'GHC.Types.LiftedRep, 'GHC.Types.LiftedRep]) diff --git a/testsuite/tests/unboxedsums/T14051.hs b/testsuite/tests/unboxedsums/T14051.hs new file mode 100644 index 0000000000..96662a946e --- /dev/null +++ b/testsuite/tests/unboxedsums/T14051.hs @@ -0,0 +1,10 @@ +{-# LANGUAGE UnboxedSums #-} + +module Main where + +import T14051a + +main :: IO () +main = print $ case func () of + (# True | #) -> 123 + _ -> 321 diff --git a/testsuite/tests/unboxedsums/T14051a.hs b/testsuite/tests/unboxedsums/T14051a.hs new file mode 100644 index 0000000000..b88f70ea05 --- /dev/null +++ b/testsuite/tests/unboxedsums/T14051a.hs @@ -0,0 +1,6 @@ +{-# LANGUAGE UnboxedSums #-} + +module T14051a where + +func :: s -> (# Bool | Bool #) +func _ = (# True | #) diff --git a/testsuite/tests/unboxedsums/all.T b/testsuite/tests/unboxedsums/all.T index eea818b6f1..45723cb4f0 100644 --- a/testsuite/tests/unboxedsums/all.T +++ b/testsuite/tests/unboxedsums/all.T @@ -32,3 +32,4 @@ test('T12711', only_ways(['ghci']), ghci_script, ['T12711.script']) # ['$MAKE -s --no-print-directory sum_api_annots']) test('UbxSumLevPoly', normal, compile, ['']) +test('T14051', normal, multi_compile, ['T14051.hs', [('T14051a.hs', '')], '-O2 -v0']) diff --git a/testsuite/tests/unboxedsums/sum_rr.hs b/testsuite/tests/unboxedsums/sum_rr.hs index 5f799fe481..448a9b2221 100644 --- a/testsuite/tests/unboxedsums/sum_rr.hs +++ b/testsuite/tests/unboxedsums/sum_rr.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE TypeInType #-} +{-# LANGUAGE DataKinds, PolyKinds #-} module Example where diff --git a/testsuite/tests/warnings/should_compile/StarBinder.hs b/testsuite/tests/warnings/should_compile/StarBinder.hs new file mode 100644 index 0000000000..09f51684ac --- /dev/null +++ b/testsuite/tests/warnings/should_compile/StarBinder.hs @@ -0,0 +1,5 @@ +{-# LANGUAGE TypeOperators, TypeFamilies #-} + +module X (type (X.*)) where + +type family (*) a b where { (*) a b = Either b a } diff --git a/testsuite/tests/warnings/should_compile/StarBinder.stderr b/testsuite/tests/warnings/should_compile/StarBinder.stderr new file mode 100644 index 0000000000..2dbcf0e800 --- /dev/null +++ b/testsuite/tests/warnings/should_compile/StarBinder.stderr @@ -0,0 +1,10 @@ + +StarBinder.hs:5:14: warning: [-Wstar-binder (in -Wdefault)] + Found binding occurrence of ‘*’ yet StarIsType is enabled. + NB. To use (or export) this operator in modules with StarIsType, + including the definition module, you must qualify it. + +StarBinder.hs:5:30: warning: [-Wstar-binder (in -Wdefault)] + Found binding occurrence of ‘*’ yet StarIsType is enabled. + NB. To use (or export) this operator in modules with StarIsType, + including the definition module, you must qualify it. diff --git a/testsuite/tests/warnings/should_compile/all.T b/testsuite/tests/warnings/should_compile/all.T index 6740990853..fd2ba85035 100644 --- a/testsuite/tests/warnings/should_compile/all.T +++ b/testsuite/tests/warnings/should_compile/all.T @@ -20,3 +20,5 @@ test('Werror01', normal, compile, ['']) test('Werror02', normal, compile, ['']) test('MissingMod', normal, multimod_compile, ['MissingMod', '-Wmissing-home-modules']) + +test('StarBinder', normal, compile, [''])
\ No newline at end of file diff --git a/testsuite/tests/warnings/should_fail/CaretDiagnostics1.stderr b/testsuite/tests/warnings/should_fail/CaretDiagnostics1.stderr index 15dedf0516..532ca18ffc 100644 --- a/testsuite/tests/warnings/should_fail/CaretDiagnostics1.stderr +++ b/testsuite/tests/warnings/should_fail/CaretDiagnostics1.stderr @@ -1,6 +1,6 @@ CaretDiagnostics1.hs:(5,3)-(7,16): error: - • Couldn't match expected type ‘IO a1’ with actual type ‘Int’ + • Couldn't match expected type ‘IO a0’ with actual type ‘Int’ • In a stmt of a 'do' block: 10000000000000000000000000000000000000 + 2 + (3 :: Int) In the expression: @@ -45,7 +45,7 @@ CaretDiagnostics1.hs:8:31-44: error: | ^^^^^^^^^^^^^^ CaretDiagnostics1.hs:13:7-11: error: - • Couldn't match expected type ‘a0 -> a0’ with actual type ‘[Char]’ + • Couldn't match expected type ‘a1 -> a1’ with actual type ‘[Char]’ • In the pattern: "γηξ" In a case alternative: "γηξ" -> () '0' In the expression: case id of { "γηξ" -> () '0' } diff --git a/testsuite/tests/wcompat-warnings/Template.hs b/testsuite/tests/wcompat-warnings/Template.hs new file mode 100644 index 0000000000..e3423c8b9f --- /dev/null +++ b/testsuite/tests/wcompat-warnings/Template.hs @@ -0,0 +1,23 @@ +{-# LANGUAGE NoMonadFailDesugaring #-} + +module WCompatWarningsOnOff where + +import qualified Data.Semigroup as Semi + +monadFail :: Monad m => m a +monadFail = do + Just _ <- undefined + undefined + +(<>) = undefined -- Semigroup warnings + +-- -fwarn-noncanonical-monoid-instances +newtype S = S Int + +instance Semi.Semigroup S where + (<>) = mappend + +instance Monoid S where + S a `mappend` S b = S (a+b) + mempty = S 0 + diff --git a/testsuite/tests/wcompat-warnings/WCompatWarningsNotOn.hs b/testsuite/tests/wcompat-warnings/WCompatWarningsNotOn.hs index 64a19e5cf9..7cd6a421e9 100644 --- a/testsuite/tests/wcompat-warnings/WCompatWarningsNotOn.hs +++ b/testsuite/tests/wcompat-warnings/WCompatWarningsNotOn.hs @@ -1,26 +1,5 @@ -- Test purpose: -- Ensure that not using -Wcompat does not enable its warnings --- {-# OPTIONS_GHC -Wcompat #-} --- {-# OPTIONS_GHC -Wno-compat #-} - -module WCompatWarningsNotOn where - -import qualified Data.Semigroup as Semi - -monadFail :: Monad m => m a -monadFail = do - Just _ <- undefined - undefined - -(<>) = undefined -- Semigroup warnings - --- -fwarn-noncanonical-monoid-instances -newtype S = S Int - -instance Semi.Semigroup S where - (<>) = mappend - -instance Semi.Monoid S where - S a `mappend` S b = S (a+b) - mempty = S 0 +{-# LANGUAGE CPP #-} +#include "Template.hs" diff --git a/testsuite/tests/wcompat-warnings/WCompatWarningsOff.hs b/testsuite/tests/wcompat-warnings/WCompatWarningsOff.hs index 6ed25f1ef7..637fbb3d7f 100644 --- a/testsuite/tests/wcompat-warnings/WCompatWarningsOff.hs +++ b/testsuite/tests/wcompat-warnings/WCompatWarningsOff.hs @@ -1,26 +1,6 @@ -- Test purpose: -- Ensure that using -Wno-compat does not switch on warnings --- {-# OPTIONS_GHC -Wcompat #-} {-# OPTIONS_GHC -Wno-compat #-} - -module WCompatWarningsOff where - -import qualified Data.Semigroup as Semi - -monadFail :: Monad m => m a -monadFail = do - Just _ <- undefined - undefined - -(<>) = undefined -- Semigroup warnings - --- -fwarn-noncanonical-monoid-instances -newtype S = S Int - -instance Semi.Semigroup S where - (<>) = mappend - -instance Semi.Monoid S where - S a `mappend` S b = S (a+b) - mempty = S 0 +{-# LANGUAGE CPP #-} +#include "Template.hs" diff --git a/testsuite/tests/wcompat-warnings/WCompatWarningsOn.hs b/testsuite/tests/wcompat-warnings/WCompatWarningsOn.hs index c155f37f42..9c7598269b 100644 --- a/testsuite/tests/wcompat-warnings/WCompatWarningsOn.hs +++ b/testsuite/tests/wcompat-warnings/WCompatWarningsOn.hs @@ -2,25 +2,5 @@ -- Ensure that -Wcompat switches on the right warnings {-# OPTIONS_GHC -Wcompat #-} --- {-# OPTIONS_GHC -Wno-compat #-} - -module WCompatWarningsOn where - -import qualified Data.Semigroup as Semi - -monadFail :: Monad m => m a -monadFail = do - Just _ <- undefined - undefined - -(<>) = undefined -- Semigroup warnings - --- -fwarn-noncanonical-monoid-instances -newtype S = S Int - -instance Semi.Semigroup S where - (<>) = mappend - -instance Semi.Monoid S where - S a `mappend` S b = S (a+b) - mempty = S 0 +{-# LANGUAGE CPP #-} +#include "Template.hs" diff --git a/testsuite/tests/wcompat-warnings/WCompatWarningsOn.stderr b/testsuite/tests/wcompat-warnings/WCompatWarningsOn.stderr index 571a24119a..5c2d9c5428 100644 --- a/testsuite/tests/wcompat-warnings/WCompatWarningsOn.stderr +++ b/testsuite/tests/wcompat-warnings/WCompatWarningsOn.stderr @@ -1,12 +1,12 @@ -WCompatWarningsOn.hs:13:5: warning: [-Wmissing-monadfail-instances (in -Wcompat)] +Template.hs:9:5: warning: [-Wmissing-monadfail-instances (in -Wcompat)] • Could not deduce (Control.Monad.Fail.MonadFail m) arising from the failable pattern ‘Just _’ (this will become an error in a future GHC release) from the context: Monad m bound by the type signature for: monadFail :: forall (m :: * -> *) a. Monad m => m a - at WCompatWarningsOn.hs:11:1-27 + at Template.hs:7:1-27 Possible fix: add (Control.Monad.Fail.MonadFail m) to the context of the type signature for: @@ -20,16 +20,16 @@ WCompatWarningsOn.hs:13:5: warning: [-Wmissing-monadfail-instances (in -Wcompat) = do Just _ <- undefined undefined -WCompatWarningsOn.hs:16:1: warning: [-Wsemigroup (in -Wcompat)] +Template.hs:12:1: warning: [-Wsemigroup (in -Wcompat)] Local definition of ‘<>’ clashes with a future Prelude name. This will become an error in a future release. -WCompatWarningsOn.hs:22:3: warning: [-Wnoncanonical-monoid-instances (in -Wcompat)] +Template.hs:18:3: warning: [-Wnoncanonical-monoid-instances (in -Wcompat)] Noncanonical ‘(<>) = mappend’ definition detected - in the instance declaration for ‘Semi.Semigroup S’. + in the instance declaration for ‘Semigroup S’. Move definition from ‘mappend’ to ‘(<>)’ -WCompatWarningsOn.hs:25:3: warning: [-Wnoncanonical-monoid-instances (in -Wcompat)] +Template.hs:21:3: warning: [-Wnoncanonical-monoid-instances (in -Wcompat)] Noncanonical ‘mappend’ definition detected in the instance declaration for ‘Monoid S’. Define as ‘mappend = (<>)’ diff --git a/testsuite/tests/wcompat-warnings/WCompatWarningsOnOff.hs b/testsuite/tests/wcompat-warnings/WCompatWarningsOnOff.hs index 44f554ee47..d644568b58 100644 --- a/testsuite/tests/wcompat-warnings/WCompatWarningsOnOff.hs +++ b/testsuite/tests/wcompat-warnings/WCompatWarningsOnOff.hs @@ -1,26 +1,6 @@ -- Test purpose: -- Ensure that -Wno-compat disables a previously set -Wcompat -{-# OPTIONS_GHC -Wcompat #-} -{-# OPTIONS_GHC -Wno-compat #-} - -module WCompatWarningsOnOff where - -import qualified Data.Semigroup as Semi - -monadFail :: Monad m => m a -monadFail = do - Just _ <- undefined - undefined - -(<>) = undefined -- Semigroup warnings - --- -fwarn-noncanonical-monoid-instances -newtype S = S Int - -instance Semi.Semigroup S where - (<>) = mappend - -instance Semi.Monoid S where - S a `mappend` S b = S (a+b) - mempty = S 0 +{-# OPTIONS_GHC -Wcompat -Wno-compat #-} +{-# LANGUAGE CPP #-} +#include "Template.hs" diff --git a/testsuite/tests/wcompat-warnings/all.T b/testsuite/tests/wcompat-warnings/all.T index 4447f994cb..5d624665ab 100644 --- a/testsuite/tests/wcompat-warnings/all.T +++ b/testsuite/tests/wcompat-warnings/all.T @@ -1,4 +1,5 @@ -test('WCompatWarningsOn', normal, compile, ['']) -test('WCompatWarningsOff', normal, compile, ['']) -test('WCompatWarningsNotOn', normal, compile, ['']) -test('WCompatWarningsOnOff', normal, compile, ['']) +# N.B. the source files are all stubs; edit Template.hs +test('WCompatWarningsOn', extra_files(['Template.hs']), compile, ['']) +test('WCompatWarningsOff', extra_files(['Template.hs']), compile, ['']) +test('WCompatWarningsNotOn', extra_files(['Template.hs']), compile, ['']) +test('WCompatWarningsOnOff', extra_files(['Template.hs']), compile, ['']) diff --git a/testsuite/timeout/WinCBindings.hsc b/testsuite/timeout/WinCBindings.hsc index a72cdcfafb..36379301a4 100644 --- a/testsuite/timeout/WinCBindings.hsc +++ b/testsuite/timeout/WinCBindings.hsc @@ -260,9 +260,6 @@ type JOBOBJECTINFOCLASS = CInt type PVOID = Ptr () type PULONG_PTR = Ptr ULONG_PTR -#if !MIN_VERSION_Win32(2,5,0) -type ULONG_PTR = CUIntPtr -#endif jobObjectExtendedLimitInformation :: JOBOBJECTINFOCLASS jobObjectExtendedLimitInformation = #const JobObjectExtendedLimitInformation diff --git a/testsuite/timeout/timeout.hs b/testsuite/timeout/timeout.hs index f72efe30ae..9f3044f36d 100644 --- a/testsuite/timeout/timeout.hs +++ b/testsuite/timeout/timeout.hs @@ -1,4 +1,5 @@ {-# OPTIONS -cpp #-} +{-# LANGUAGE LambdaCase #-} module Main where import Control.Concurrent (forkIO, threadDelay) @@ -21,6 +22,7 @@ import WinCBindings import Foreign import System.Win32.DebugApi import System.Win32.Types +import System.Win32.Console.CtrlHandler #endif main :: IO () @@ -129,28 +131,35 @@ run secs cmd = let handleInterrupt action = action `onException` terminateJobObject job 99 - - handleInterrupt $ do - resumeThread (piThread pi) - -- The program is now running - let handle = piProcess pi - let millisecs = secs * 1000 - rc <- waitForJobCompletion job ioPort (fromIntegral millisecs) - closeHandle ioPort - - if not rc - then do terminateJobObject job 99 - closeHandle job - exitWith (ExitFailure 99) - else alloca $ \p_exitCode -> - do terminateJobObject job 0 -- Ensure it's all really dead. - closeHandle job - r <- getExitCodeProcess handle p_exitCode - if r then do ec <- peek p_exitCode - let ec' = if ec == 0 - then ExitSuccess - else ExitFailure $ fromIntegral ec - exitWith ec' - else errorWin "getExitCodeProcess" + handleCtrl _ = do + terminateJobObject job 99 + closeHandle ioPort + closeHandle job + exitWith (ExitFailure 99) + return True + + withConsoleCtrlHandler handleCtrl $ + handleInterrupt $ do + resumeThread (piThread pi) + -- The program is now running + let handle = piProcess pi + let millisecs = secs * 1000 + rc <- waitForJobCompletion job ioPort (fromIntegral millisecs) + closeHandle ioPort + + if not rc + then do terminateJobObject job 99 + closeHandle job + exitWith (ExitFailure 99) + else alloca $ \p_exitCode -> + do terminateJobObject job 0 + -- Ensured it's all really dead. + closeHandle job + r <- getExitCodeProcess handle p_exitCode + if r + then peek p_exitCode >>= \case + 0 -> exitWith ExitSuccess + e -> exitWith $ ExitFailure (fromIntegral e) + else errorWin "getExitCodeProcess" #endif |