diff options
Diffstat (limited to 'utils')
80 files changed, 2185 insertions, 3665 deletions
diff --git a/utils/check-api-annotations/check-api-annotations.cabal b/utils/check-api-annotations/check-api-annotations.cabal index 880f4d6603..3d07608577 100644 --- a/utils/check-api-annotations/check-api-annotations.cabal +++ b/utils/check-api-annotations/check-api-annotations.cabal @@ -24,6 +24,6 @@ Executable check-api-annotations Build-Depends: base >= 4 && < 5, containers, - Cabal >= 2.0 && < 2.1, + Cabal >= 2.4.0 && < 2.5, directory, ghc diff --git a/utils/check-ppr/Main.hs b/utils/check-ppr/Main.hs index 2fd44b2be0..a5aeee2f1d 100644 --- a/utils/check-ppr/Main.hs +++ b/utils/check-ppr/Main.hs @@ -31,7 +31,8 @@ testOneFile :: FilePath -> String -> IO () testOneFile libdir fileName = do p <- parseOneFile libdir fileName let - origAst = showAstData BlankSrcSpan (pm_parsed_source p) + origAst = showSDoc unsafeGlobalDynFlags + $ showAstData BlankSrcSpan (pm_parsed_source p) pped = pragmas ++ "\n" ++ pp (pm_parsed_source p) anns = pm_annotations p pragmas = getPragmas anns @@ -45,7 +46,9 @@ testOneFile libdir fileName = do p' <- parseOneFile libdir newFile - let newAstStr = showAstData BlankSrcSpan (pm_parsed_source p') + let newAstStr :: String + newAstStr = showSDoc unsafeGlobalDynFlags + $ showAstData BlankSrcSpan (pm_parsed_source p') writeFile newAstFile newAstStr if origAst == newAstStr diff --git a/utils/check-ppr/check-ppr.cabal b/utils/check-ppr/check-ppr.cabal index 584558b3ff..2da21d766b 100644 --- a/utils/check-ppr/check-ppr.cabal +++ b/utils/check-ppr/check-ppr.cabal @@ -25,7 +25,7 @@ Executable check-ppr Build-Depends: base >= 4 && < 5, bytestring, containers, - Cabal >= 2.0 && < 2.1, + Cabal >= 2.4 && < 2.5, directory, filepath, ghc diff --git a/utils/deriveConstants/Main.hs b/utils/deriveConstants/Main.hs index e5f14e1eab..5d5dbc404f 100644 --- a/utils/deriveConstants/Main.hs +++ b/utils/deriveConstants/Main.hs @@ -489,15 +489,8 @@ wanteds os = concat ,closureSize C "StgAtomicallyFrame" ,closureField C "StgAtomicallyFrame" "code" - ,closureField C "StgAtomicallyFrame" "next_invariant_to_check" ,closureField C "StgAtomicallyFrame" "result" - ,closureField C "StgInvariantCheckQueue" "invariant" - ,closureField C "StgInvariantCheckQueue" "my_execution" - ,closureField C "StgInvariantCheckQueue" "next_queue_entry" - - ,closureField C "StgAtomicInvariant" "code" - ,closureField C "StgTRecHeader" "enclosing_trec" ,closureSize C "StgCatchSTMFrame" @@ -731,7 +724,7 @@ getWanted verbose os tmpdir gccProgram gccFlags nmProgram mobjdumpProgram "", "#include \"PosixSource.h\"", "#include \"Rts.h\"", - "#include \"Stable.h\"", + "#include \"StableName.h\"", "#include \"Capability.h\"", "", "#include <inttypes.h>", diff --git a/utils/dll-split/Main.hs b/utils/dll-split/Main.hs deleted file mode 100644 index c3f5a15a4a..0000000000 --- a/utils/dll-split/Main.hs +++ /dev/null @@ -1,82 +0,0 @@ -module Main (main) where - -import Control.Monad -import Data.Function -import Data.List -import Data.Map (Map) -import qualified Data.Map as Map -import Data.Maybe -import Data.Set (Set) -import qualified Data.Set as Set -import System.Environment -import System.Exit -import System.FilePath - -main :: IO () -main = do args <- getArgs - case args of - [depfile, startModule, reachableModules] -> - doit depfile - (Module startModule) - (Set.fromList $ map Module $ words reachableModules) - _ -> error "dll-split: Bad args" - -doit :: FilePath -> Module -> Set Module -> IO () -doit depfile startModule expectedReachableMods - = do xs <- readFile depfile - let ys = catMaybes $ map mkEdge $ lines xs - mapping = mkMap ys - actualReachableMods = reachable mapping startModule - unless (actualReachableMods == expectedReachableMods) $ do - let extra = actualReachableMods Set.\\ expectedReachableMods - redundant = expectedReachableMods Set.\\ actualReachableMods - tellSet name set = unless (Set.null set) $ - let ms = map moduleName (Set.toList set) - in putStrLn (name ++ ": " ++ unwords ms) - putStrLn ("Reachable modules from " ++ moduleName startModule - ++ " out of date") - putStrLn "Please fix compiler/ghc.mk, or building DLLs on Windows may break (#7780)" - tellSet "Redundant modules" redundant - tellSet "Extra modules" extra - exitFailure - -newtype Module = Module String - deriving (Eq, Ord) - -moduleName :: Module -> String -moduleName (Module name) = name - --- Given: --- compiler/stage2/build/X86/Regs.o : compiler/stage2/build/CodeGen/Platform.hi --- Produce: --- Just ("X86.Regs", "CodeGen.Platform") -mkEdge :: String -> Maybe (Module, Module) -mkEdge str = case words str of - [from, ":", to] - | Just from' <- getModule from - , Just to' <- getModule to -> - Just (from', to') - _ -> - Nothing - where getModule xs - = case stripPrefix "compiler/stage2/build/" xs of - Just xs' -> - let name = filePathToModuleName $ dropExtension xs' - in Just $ Module name - Nothing -> Nothing - filePathToModuleName = map filePathToModuleNameChar - filePathToModuleNameChar '/' = '.' - filePathToModuleNameChar c = c - -mkMap :: [(Module, Module)] -> (Map Module (Set Module)) -mkMap edges = let groupedEdges = groupBy ((==) `on` fst) $ sort edges - mkEdgeMap ys = (fst (head ys), Set.fromList (map snd ys)) - in Map.fromList $ map mkEdgeMap groupedEdges - -reachable :: Map Module (Set Module) -> Module -> Set Module -reachable mapping startModule = f Set.empty startModule - where f done m = if m `Set.member` done - then done - else foldl' f (m `Set.insert` done) (get m) - get m = Set.toList (Map.findWithDefault Set.empty m mapping) - diff --git a/utils/dll-split/dll-split.cabal b/utils/dll-split/dll-split.cabal deleted file mode 100644 index 8730b4fcdc..0000000000 --- a/utils/dll-split/dll-split.cabal +++ /dev/null @@ -1,28 +0,0 @@ -Name: dll-split -Version: 0.1 -Copyright: XXX -License: BSD3 --- XXX License-File: LICENSE -Author: XXX -Maintainer: XXX -Synopsis: A tool for verifying the partitioning of the GHC library on Windows -Description: - Due to various toolchain issues (see GHC Trac #5987) we are forced to keep - DLLs on Windows smaller than 65,000 symbols. To accomplish this we split - the @ghc@ package into multiple DLLs by partitioning defined in the - build system (see @compiler/ghc.mk@). - . - This tool checks this partitioning to ensure consistency with the actual - module dependencies. -Category: Development -build-type: Simple -cabal-version: >=1.10 - -Executable dll-split - Default-Language: Haskell2010 - Main-Is: Main.hs - - Build-Depends: base >= 4 && < 5, - containers, - filepath - diff --git a/utils/dll-split/ghc.mk b/utils/dll-split/ghc.mk deleted file mode 100644 index 27e11bd9a2..0000000000 --- a/utils/dll-split/ghc.mk +++ /dev/null @@ -1,23 +0,0 @@ -# ----------------------------------------------------------------------------- -# -# (c) 2009 The University of Glasgow -# -# This file is part of the GHC build system. -# -# To understand how the build system works and how to modify it, see -# http://ghc.haskell.org/trac/ghc/wiki/Building/Architecture -# http://ghc.haskell.org/trac/ghc/wiki/Building/Modifying -# -# ----------------------------------------------------------------------------- - -utils/dll-split_USES_CABAL = YES -utils/dll-split_PACKAGE = dll-split -utils/dll-split_dist-install_PROGNAME = dll-split -utils/dll-split_dist-install_INSTALL = NO -utils/dll-split_dist-install_INSTALL_INPLACE = YES -# Use the stage0 instead of the stage1 compiler to build dll-split, to -# prevent: "dll-split: cannot execute binary file: Exec format error". -# Programs built with the stage1 compiler can only run on TARGET -# architecture, whereas dll-split is used during the GHC build process (see -# rules/build-package-way.mk) on the BUILD (=HOST) architectue. -$(eval $(call build-prog,utils/dll-split,dist-install,0)) diff --git a/utils/fs/README b/utils/fs/README new file mode 100644 index 0000000000..5011939a38 --- /dev/null +++ b/utils/fs/README @@ -0,0 +1,4 @@ +This "fs" library, used by various ghc utilities is used to share some common +I/O filesystem functions with different packages. + +This file is copied across the build-system by configure. diff --git a/utils/fs/fs.c b/utils/fs/fs.c new file mode 100644 index 0000000000..0f8fbe707f --- /dev/null +++ b/utils/fs/fs.c @@ -0,0 +1,293 @@ +/* ----------------------------------------------------------------------------- + * + * (c) Tamar Christina 2018 + * + * Windows I/O routines for file opening. + * + * NOTE: Only modify this file in utils/fs/ and rerun configure. Do not edit + * this file in any other directory as it will be overwritten. + * + * ---------------------------------------------------------------------------*/ +#include "fs.h" +#include <stdio.h> + +#if defined(_WIN32) + +#include <stdbool.h> +#include <stdlib.h> +#include <stdint.h> + +#include <windows.h> +#include <io.h> +#include <fcntl.h> +#include <wchar.h> +#include <sys/stat.h> +#include <sys/types.h> +#include <share.h> + +/* This function converts Windows paths between namespaces. More specifically + It converts an explorer style path into a NT or Win32 namespace. + This has several caveats but they are caviats that are native to Windows and + not POSIX. See + https://msdn.microsoft.com/en-us/library/windows/desktop/aa365247.aspx. + Anything else such as raw device paths we leave untouched. The main benefit + of doing any of this is that we can break the MAX_PATH restriction and also + access raw handles that we couldn't before. */ +static wchar_t* __hs_create_device_name (const wchar_t* filename) { + const wchar_t* win32_dev_namespace = L"\\\\.\\"; + const wchar_t* win32_file_namespace = L"\\\\?\\"; + const wchar_t* nt_device_namespace = L"\\Device\\"; + const wchar_t* unc_prefix = L"UNC\\"; + const wchar_t* network_share = L"\\\\"; + + wchar_t* result = _wcsdup (filename); + wchar_t ns[10] = {0}; + + /* If the file is already in a native namespace don't change it. */ + if ( wcsncmp (win32_dev_namespace , filename, 4) == 0 + || wcsncmp (win32_file_namespace, filename, 4) == 0 + || wcsncmp (nt_device_namespace , filename, 8) == 0) + return result; + + /* Since we're using the lower level APIs we must normalize slashes now. The + Win32 API layer will no longer convert '/' into '\\' for us. */ + for (size_t i = 0; i < wcslen (result); i++) + { + if (result[i] == L'/') + result[i] = L'\\'; + } + + /* Now resolve any . and .. in the path or subsequent API calls may fail since + Win32 will no longer resolve them. */ + DWORD nResult = GetFullPathNameW (result, 0, NULL, NULL) + 1; + wchar_t *temp = _wcsdup (result); + result = malloc (nResult * sizeof (wchar_t)); + if (GetFullPathNameW (temp, nResult, result, NULL) == 0) + { + goto cleanup; + } + + free (temp); + + if (wcsncmp (network_share, result, 2) == 0) + { + if (swprintf (ns, 10, L"%ls%ls", win32_file_namespace, unc_prefix) <= 0) + { + goto cleanup; + } + } + else if (swprintf (ns, 10, L"%ls", win32_file_namespace) <= 0) + { + goto cleanup; + } + + /* Create new string. */ + int bLen = wcslen (result) + wcslen (ns) + 1; + temp = _wcsdup (result); + result = malloc (bLen * sizeof (wchar_t)); + if (swprintf (result, bLen, L"%ls%ls", ns, temp) <= 0) + { + goto cleanup; + } + + free (temp); + + return result; + +cleanup: + free (temp); + free (result); + return NULL; +} + +#define HAS_FLAG(a,b) ((a & b) == b) + +int FS(swopen) (const wchar_t* filename, int oflag, int shflag, int pmode) +{ + /* Construct access mode. */ + DWORD dwDesiredAccess = 0; + if (HAS_FLAG (oflag, _O_RDONLY)) + dwDesiredAccess |= GENERIC_READ | FILE_READ_DATA | FILE_READ_ATTRIBUTES | + FILE_WRITE_ATTRIBUTES;; + if (HAS_FLAG (oflag, _O_RDWR)) + dwDesiredAccess |= GENERIC_WRITE | GENERIC_READ | FILE_READ_DATA | + FILE_WRITE_DATA | FILE_READ_ATTRIBUTES | + FILE_WRITE_ATTRIBUTES; + if (HAS_FLAG (oflag, _O_WRONLY)) + dwDesiredAccess|= GENERIC_WRITE | FILE_WRITE_DATA | + FILE_READ_ATTRIBUTES | FILE_WRITE_ATTRIBUTES; + + /* Construct shared mode. */ + DWORD dwShareMode = FILE_SHARE_DELETE | FILE_SHARE_READ | FILE_SHARE_WRITE; + if (HAS_FLAG (shflag, _SH_DENYRW)) + dwShareMode &= ~(FILE_SHARE_READ | FILE_SHARE_WRITE); + if (HAS_FLAG (shflag, _SH_DENYWR)) + dwShareMode &= ~FILE_SHARE_WRITE; + if (HAS_FLAG (shflag, _SH_DENYRD)) + dwShareMode &= ~FILE_SHARE_READ; + if (HAS_FLAG (pmode, _S_IWRITE)) + dwShareMode |= FILE_SHARE_READ | FILE_SHARE_WRITE; + if (HAS_FLAG (pmode, _S_IREAD)) + dwShareMode |= FILE_SHARE_READ; + + /* Override access mode with pmode if creating file. */ + if (HAS_FLAG (oflag, _O_CREAT)) + { + if (HAS_FLAG (pmode, _S_IWRITE)) + dwDesiredAccess |= FILE_GENERIC_WRITE; + if (HAS_FLAG (pmode, _S_IREAD)) + dwDesiredAccess |= FILE_GENERIC_READ; + } + + /* Create file disposition. */ + DWORD dwCreationDisposition = OPEN_EXISTING; + if (HAS_FLAG (oflag, _O_CREAT)) + dwCreationDisposition = OPEN_ALWAYS; + if (HAS_FLAG (oflag, (_O_CREAT | _O_EXCL))) + dwCreationDisposition = CREATE_NEW; + if (HAS_FLAG (oflag, _O_TRUNC) && !HAS_FLAG (oflag, _O_CREAT)) + dwCreationDisposition = TRUNCATE_EXISTING; + + /* Set file access attributes. */ + DWORD dwFlagsAndAttributes = FILE_ATTRIBUTE_NORMAL; + if (HAS_FLAG (oflag, _O_RDONLY)) + dwFlagsAndAttributes |= 0; /* No special attribute. */ + if (HAS_FLAG (oflag, (_O_CREAT | _O_TEMPORARY))) + dwFlagsAndAttributes |= FILE_FLAG_DELETE_ON_CLOSE; + if (HAS_FLAG (oflag, (_O_CREAT | _O_SHORT_LIVED))) + dwFlagsAndAttributes |= FILE_ATTRIBUTE_TEMPORARY; + if (HAS_FLAG (oflag, _O_RANDOM)) + dwFlagsAndAttributes |= FILE_FLAG_RANDOM_ACCESS; + if (HAS_FLAG (oflag, _O_SEQUENTIAL)) + dwFlagsAndAttributes |= FILE_FLAG_SEQUENTIAL_SCAN; + /* Flag is only valid on it's own. */ + if (dwFlagsAndAttributes != FILE_ATTRIBUTE_NORMAL) + dwFlagsAndAttributes &= ~FILE_ATTRIBUTE_NORMAL; + + /* Set security attributes. */ + SECURITY_ATTRIBUTES securityAttributes; + ZeroMemory (&securityAttributes, sizeof(SECURITY_ATTRIBUTES)); + securityAttributes.bInheritHandle = !(oflag & _O_NOINHERIT); + securityAttributes.lpSecurityDescriptor = NULL; + securityAttributes.nLength = sizeof(SECURITY_ATTRIBUTES); + + wchar_t* _filename = __hs_create_device_name (filename); + if (!_filename) + return -1; + + HANDLE hResult + = CreateFileW (_filename, dwDesiredAccess, dwShareMode, &securityAttributes, + dwCreationDisposition, dwFlagsAndAttributes, NULL); + free (_filename); + if (INVALID_HANDLE_VALUE == hResult) + return -1; + + /* Now we have a Windows handle, we have to convert it to an FD and apply + the remaining flags. */ + const int flag_mask = _O_APPEND | _O_RDONLY | _O_TEXT | _O_WTEXT; + int fd = _open_osfhandle ((intptr_t)hResult, oflag & flag_mask); + if (-1 == fd) + return -1; + + /* Finally we can change the mode to the requested one. */ + const int mode_mask = _O_TEXT | _O_BINARY | _O_U16TEXT | _O_U8TEXT | _O_WTEXT; + if ((oflag & mode_mask) && (-1 == _setmode (fd, oflag & mode_mask))) + return -1; + + return fd; +} + +FILE *FS(fwopen) (const wchar_t* filename, const wchar_t* mode) +{ + int shflag = 0; + int pmode = 0; + int oflag = 0; + + int len = wcslen (mode); + int i; + #define IS_EXT(X) ((i < (len - 1)) && mode[i] == X) + + for (i = 0; i < len; i++) + { + switch (mode[i]) + { + case L'a': + if (IS_EXT (L'+')) + oflag |= _O_RDWR | _O_CREAT | _O_APPEND; + else + oflag |= _O_WRONLY | _O_CREAT | _O_APPEND; + break; + case L'r': + if (IS_EXT (L'+')) + oflag |= _O_RDWR; + else + oflag |= _O_RDONLY; + break; + case L'w': + if (IS_EXT (L'+')) + oflag |= _O_RDWR | _O_CREAT | _O_TRUNC; + else + oflag |= _O_WRONLY | _O_CREAT | _O_TRUNC; + break; + case L'b': + oflag |= _O_BINARY; + break; + case L't': + oflag |= _O_TEXT; + break; + case L'c': + case L'n': + oflag |= 0; + break; + case L'S': + oflag |= _O_SEQUENTIAL; + break; + case L'R': + oflag |= _O_RANDOM; + break; + case L'T': + oflag |= _O_SHORT_LIVED; + break; + case L'D': + oflag |= _O_TEMPORARY; + break; + default: + if (wcsncmp (mode, L"ccs=UNICODE", 11) == 0) + oflag |= _O_WTEXT; + else if (wcsncmp (mode, L"ccs=UTF-8", 9) == 0) + oflag |= _O_U8TEXT; + else if (wcsncmp (mode, L"ccs=UTF-16LE", 12) == 0) + oflag |= _O_U16TEXT; + else continue; + } + } + #undef IS_EXT + + int fd = FS(swopen) (filename, oflag, shflag, pmode); + FILE* file = _wfdopen (fd, mode); + return file; +} + +FILE *FS(fopen) (const char* filename, const char* mode) +{ + size_t len = mbstowcs (NULL, filename, 0); + wchar_t *w_filename = malloc (sizeof (wchar_t) * (len + 1)); + mbstowcs (w_filename, filename, len); + w_filename[len] = L'\0'; + + len = mbstowcs (NULL, mode, 0); + wchar_t *w_mode = malloc (sizeof (wchar_t) * (len + 1)); + mbstowcs (w_mode, mode, len); + w_mode[len] = L'\0'; + + FILE *result = FS(fwopen) (w_filename, w_mode); + free (w_filename); + free (w_mode); + return result; +} +#else +FILE *FS(fopen) (const char* filename, const char* mode) +{ + return fopen (filename, mode); +} +#endif diff --git a/utils/fs/fs.h b/utils/fs/fs.h new file mode 100644 index 0000000000..ab2eded2a1 --- /dev/null +++ b/utils/fs/fs.h @@ -0,0 +1,36 @@ +/* ----------------------------------------------------------------------------- + * + * (c) Tamar Christina 2018 + * + * Windows I/O routines for file opening. + * + * NOTE: Only modify this file in utils/fs/ and rerun configure. Do not edit + * this file in any other directory as it will be overwritten. + * + * ---------------------------------------------------------------------------*/ + +#pragma once + +#include <stdio.h> + +#if !defined(FS_NAMESPACE) +#define FS_NAMESPACE hs +#endif + +/* Play some dirty tricks to get CPP to expand correctly. */ +#define FS_FULL(ns, name) __##ns##_##name +#define prefix FS_NAMESPACE +#define FS_L(p, n) FS_FULL(p, n) +#define FS(name) FS_L(prefix, name) + +#if defined(_WIN32) +#include <wchar.h> + +int FS(swopen) (const wchar_t* filename, int oflag, + int shflag, int pmode); +FILE *FS(fwopen) (const wchar_t* filename, const wchar_t* mode); +FILE *FS(fopen) (const char* filename, const char* mode); +#else + +FILE *FS(fopen) (const char* filename, const char* mode); +#endif diff --git a/utils/gen-dll/Main.hs b/utils/gen-dll/Main.hs new file mode 100644 index 0000000000..7cc965bd7d --- /dev/null +++ b/utils/gen-dll/Main.hs @@ -0,0 +1,510 @@ +{-# LANGUAGE Safe #-} +{-# LANGUAGE CPP #-} + +{- + gen-dll is a replacement for dll-split which aims to solve a simple problem + during the building of stage2. The issue is that the PE image format only has + a 16-bit field for the symbol count. This means we can't have more than 2^16-1 + symbols in a single PE file. See Trac #5987. + + gen-dll solves this issue by partitioning the object files in such a way that + a single dll never has more than the allowed amount of symbols. The general + workflow of gen-dll is: + + 1) use nm -g to dump the symbols defined in each object file, from this dump + we collect three key pieces information: + a) the object file the symbol belongs to + b) the symbol's kind (e.g data or function) + c) the symbol name. + + 2) If the amount of symbols is lower than the maximum, we're done and we'll + just link the entire list of symbols and move on. + + If however we have too many symbols we'll partition the symbols using a + per object file granularity. This is because we can't split the content of + an object file. An oc belongs to one and only one image file. + + 3) Once we have the partitioning, we sub partition these into two groups for + each partition: + a) data + b) function + + The reason for this is that data exports are directly accessed, whereas + functions generally go through a trampoline. The trampolines are there to + allow for extra functionality such as delay loading (if requested) and to + cover for memory model changes due to linking all the object code in on + PE image. + + Data is usually accessed direct, so we don't want the trampoline otherwise + extern int foo; + would point to executable code instead of data. + + 4) Once we have everything correctly tagged, the partitions are dumped into a + module definition file (def). Each file is named <dll-name>-pt<num>.<ext> + which is also the partitioning scheme used for all other files including + the resulting dlls. + + From the .def file we use libtool or genlib (when available) to generate + an import library. In this case we generate a GNU style import library + See Note [BFD import library]. + + These import libraries are used to break the cyclic dependencies that may + exist between the symbols due to the random partitioning. e.g. A may + require B, but A and B can be in different dlls. With the import libraries + we promise A that at runtime it'll have B, and vice versa. The Windows + runtime linker and loader will take care of breaking this cycle at runtime. + + 5) Once we have an import library for each partition, we start linking the + final dlls. if e.g. we have 3 dlls, linking dll 1 means passing import + libraries 2 and 3 as an argument to the linking of dll 1. This allows it + to find all symbols since PE image files can't have dangling symbols. + + 6) After creating the dlls the final step is to create one top level import + library that is named after the original dll that we were supposed to link. + + To continue the 3 split example. say we were supposed to make libfoo.dll, + instead we created libfoo-pt1.dll, libfoo-pt2.dll and libfoo-pt3.dll. + Obviously using -lfoo would no longer locate the dlls. + + This is solved by using import libraries again. GNU style import libraries + are just plain AR archives where each object file essentially contains + only 1 symbol and the dll in which to find this symbol. + + A proper linker processes all the object files in this AR file (lld, ld and + ghci do this.) and so while genlib and libtool don't allow you to create + import libraries with multiple dll pointers, it is trivial to do. + + We use ar to merge together the import libraries into a large complete one. + e.g. libfoo-pt1.dll.a, libfoo-pt2.dll.a and libfoo-pt3.dll.a are merged + into libfoo.dll.a. The name isn't coincidental. On Windows you don't link + directly against a dll, instead you link against an import library that + then tells you how to get to the dll functions. + + In this case by creating a correctly named merged import library we solve + the -lfoo problem. + + In the end we end up with libfoo-pt1.dll, libfoo-pt2.dll and libfoo-pt3.dll + along with libfoo.dll.a. To the rest of the pipeline the split is + completely transparent as -lfoo will just continue to work, and the linker + is responsible for populating the IAT (Import Address Table) with the + actual dlls we need. + + This scheme is fully scalable and will not need manual maintenance or + intervention like dll-split needed. If we ever do switch to compiling using + Microsoft compilers, we need to use a custom tool to modify the PE import + libraries lib.exe creates. This is slightly more work but for now we can just + rely on the GNU import libraries. + + If supported by the stage1 compiler, we'll create dll's which can be used as + SxS assemblies, but in order for us to do so, we have to give GHC some extra + information such as the stable abi name for the dll and the version of the + dll being created. This is purely a deployment thing and does not really + affect the workings of this tool. +-} +module Main(main) where + +import Control.Arrow ((***)) +import Control.Monad (when, forM_) +import Control.Exception (bracket) + +import Data.Char (toLower, isSpace) +import Data.List (isPrefixOf, nub, sort, (\\)) +import qualified Data.Map as M (Map(), alter, empty, toList) + +import System.Environment (getArgs) +import System.Exit (ExitCode(..), exitWith) +import System.Directory (findFilesWith, getCurrentDirectory) +import System.FilePath (takeBaseName, takeDirectory, dropExtension, (<.>) + ,takeFileName) +import System.IO (hClose, hGetContents, withFile, IOMode(..), hPutStrLn, openFile) +import System.Process (proc, createProcess_, StdStream (..), CreateProcess(..) + ,waitForProcess) + +import Foreign.C.Types (CInt(..), ) +import Foreign.C.String (withCWString, peekCWString, CWString) +import Foreign.Ptr (Ptr) +import Foreign.Storable (peek) +import Foreign.Marshal.Array (peekArray) +import Foreign.Marshal.Alloc (alloca) + +#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 + +-- Setup some standard program names. +nm :: FilePath +nm = NM_TOOL_BIN + +libexe :: FilePath +libexe = LIB_TOOL_BIN + +genlib :: FilePath +genlib = GENLIB_TOOL_BIN + +ar :: FilePath +ar = AR_TOOL_BIN + +-- Technically speaking the limit for the amount of symbols you can have in a +-- dll is 2^16-1, however Microsoft's lib.exe for some reason refuses to link +-- up to this amount. The reason is likely that it adds some extra symbols in +-- the generated dll, such as dllmain etc. So we reserve some space in the +-- symbol table to accomodate this. This number is just purely randomly chosen. +#define SYMBOL_PADDING 10 + +usage :: IO () +usage = putStrLn $ unlines [ " -= Split a dll if required and perform the linking =- " + , "" + , " Usage: gen-dll <action>" + , "" + , " Where <action> is one of:" + , " link perform a real link of dll, " + , " arguments: dir distdir way flags libs objs out link_cmd delay name version" + ] + +main :: IO () +main = do + args <- getArgs + if null args + then usage + else case (head args) of + "link" -> let (dir:distdir:way:extra_flags:extra_libs:objs:output: + command:delayed:abi_name:abi_version:_) = tail args + in process_dll_link dir distdir way extra_flags extra_libs + objs output command delayed abi_name + abi_version + _ -> usage + +type Symbol = String +type Symbols = [Symbol] +type SymbolType = Char +data Obj + = Obj { objName :: String + , objCount :: Int + , objItems :: [(SymbolType, Symbol)] + } + deriving Show +type Objs = [Obj] + +-- | Create the final DLL by using the provided arguments +-- This also creates the resulting special import library. +process_dll_link :: String -- ^ dir + -> String -- ^ distdir + -> String -- ^ way + -> String -- ^ extra flags + -> String -- ^ extra libraries to link + -> String -- ^ object files to link + -> String -- ^ output filename + -> String -- ^ link command + -> String -- ^ create delay load import libs + -> String -- ^ SxS Name + -> String -- ^ SxS version + -> IO () +process_dll_link _dir _distdir _way extra_flags extra_libs objs_files output + link_cmd delay_imp sxs_name sxs_version + = do let base = dropExtension output + -- We need to know how many symbols came from other static archives + -- So take the total number of symbols and remove those we know came + -- from the object files. Use this to lower the max amount of symbols. + -- + -- This granularity is the best we can do without --print-map like info. + raw_exports <- execProg nm Nothing ["-g", "--defined-only", objs_files] + putStrLn $ "Processing symbols.." + + let objs = collectObjs raw_exports + num_sym = foldr (\a b -> b + objCount a) 0 objs + exports = base <.> "lst" + + putStrLn $ "Number of symbols in object files for " ++ output ++ ": " ++ show num_sym + + _ <- withFile exports WriteMode $ \hExports -> + mapM_ (hPutStrLn hExports . unlines . map snd . objItems) objs + +#if defined(GEN_SXS) + -- Side-by-Side assembly generation flags for GHC. Pass these along so the DLLs + -- get the proper manifests generated. + let sxs_opts = [ "-fgen-sxs-assembly" + , "-dylib-abi-name" + , show sxs_name + , "-dylib-abi-version" + , show sxs_version + ] +#else + let sxs_opts = [] +#endif + + -- Now check that the DLL doesn't have too many symbols. See trac #5987. + case num_sym > dll_max_symbols of + False -> do putStrLn $ "DLL " ++ output ++ " OK, no need to split." + let defFile = base <.> "def" + dll_import = base <.> "dll.a" + + build_import_lib base (takeFileName output) defFile objs + + _ <- execProg link_cmd Nothing + $ concat [[objs_files + ,extra_libs + ,extra_flags + ] + ,sxs_opts + ,["-fno-shared-implib" + ,"-optl-Wl,--retain-symbols-file=" ++ exports + ,"-o" + ,output + ] + ] + + build_delay_import_lib defFile dll_import delay_imp + + True -> do putStrLn $ "Too many symbols for a single DLL " ++ output + putStrLn "We'll have to split the dll..." + putStrLn $ "OK, we only have space for " + ++ show dll_max_symbols + ++ " symbols from object files when building " + ++ output + + -- First split the dlls up by whole object files + -- To do this, we iterate over all object file and + -- generate a the partitions based on allowing a + -- maximum of $DLL_MAX_SYMBOLS in one DLL. + let spl_objs = groupObjs objs + n_spl_objs = length spl_objs + base' = base ++ "-pt" + + mapM_ (\(n, _) -> putStrLn $ ">> DLL split at " ++ show n ++ " symbols.") spl_objs + putStrLn $ "OK, based on the amount of symbols we'll split the DLL into " ++ show n_spl_objs ++ " pieces." + + -- Start off by creating the import libraries to break the + -- mutual dependency chain. + forM_ (zip [(1::Int)..] spl_objs) $ \(i, (n, o)) -> + do putStrLn $ "Processing file " ++ show i ++ " of " + ++ show n_spl_objs ++ " with " ++ show n + ++ " symbols." + let base_pt = base' ++ show i + file = base_pt <.> "def" + dll = base_pt <.> "dll" + lst = base_pt <.> "lst" + + _ <- withFile lst WriteMode $ \hExports -> + mapM_ (hPutStrLn hExports . unlines . map snd . objItems) o + + build_import_lib base_pt (takeFileName dll) file o + + -- Now create the actual DLLs by using the import libraries + -- to break the mutual recursion. + forM_ (zip [1..] spl_objs) $ \(i, (n, _)) -> + do putStrLn $ "Creating DLL " ++ show i ++ " of " + ++ show n_spl_objs ++ " with " ++ show n + ++ " symbols." + let base_pt = base' ++ show i + file = base_pt <.> "def" + dll = base_pt <.> "dll" + lst = base_pt <.> "lst" + imp_lib = base_pt <.> "dll.a" + indexes = [1..(length spl_objs)]\\[i] + libs = map (\ix -> (base' ++ show ix) <.> "dll.a") indexes + + _ <- execProg link_cmd Nothing + $ concat [[objs_files + ,extra_libs + ,extra_flags + ,file + ] + ,libs + ,sxs_opts + ,["-fno-shared-implib" + ,"-optl-Wl,--retain-symbols-file=" ++ lst + ,"-o" + ,dll + ] + ] + + -- build_delay_import_lib file imp_lib delay_imp + putStrLn $ "Created " ++ dll ++ "." + + -- And finally, merge the individual import libraries into + -- one with the name of the original library we were + -- supposed to make. This means that nothing has to really + -- know how we split up the DLLs, for everything else it'so + -- as if it's still one large assembly. + create_merged_archive base base' (length spl_objs) + + +collectObjs :: [String] -> Objs +collectObjs = map snd . M.toList . foldr collectObjs' M.empty + +collectObjs' :: String -> M.Map String Obj -> M.Map String Obj +collectObjs' [] m = m +collectObjs' str_in m + = let clean = dropWhile isSpace + str = clean str_in + (file, rest) = ((takeWhile (/=':') . clean) *** clean) $ + break isSpace str + (typ , sym ) = (id *** clean) $ break isSpace rest + obj = Obj { objName = file + , objCount = 1 + , objItems = [(head typ, sym)] + } + upd value + = if length typ /= 1 + then value + else Just $ maybe obj + (\o -> o { objCount = objCount o + 1 + , objItems = (head typ, sym) : objItems o + }) + value + in M.alter upd file m + +-- Split a list of objects into globals and functions +splitObjs :: Objs -> (Symbols, Symbols) +splitObjs [] = ([], []) +splitObjs (y:ys) = group_ (objItems y) (splitObjs ys) + where globals = "DdGgrRSsbBC" + group_ :: [(Char, Symbol)] -> (Symbols, Symbols) -> (Symbols, Symbols) + group_ [] x = x + group_ (x:xs) (g, f) | fst x `elem` globals = group_ xs (snd x:g, f) + | otherwise = group_ xs (g, snd x:f) + +-- Determine how to split the objects up. +groupObjs :: Objs -> [(Int, Objs)] +groupObjs = binObjs 0 [] + where binObjs :: Int -> Objs -> Objs -> [(Int, Objs)] + binObjs n l [] = [(n, l)] + binObjs n l (o:os) + = let nx = objCount o + n' = n + nx + in if n' > dll_max_symbols + then (n, l) : binObjs 0 [] os + else binObjs n' (o:l) os + +-- Maximum number of symbols to allow into +-- one DLL. This is the split factor used. +dll_max_symbols :: Int +dll_max_symbols = 65535 - SYMBOL_PADDING -- Some padding for required symbols. + +isTrue :: String -> Bool +isTrue s = let s' = map toLower s + in case () of + () | s' == "yes" -> True + | s' == "no" -> False + | otherwise -> error $ "Expected yes/no but got '" ++ s ++ "'" + +foreign import WINDOWS_CCONV unsafe "Shellapi.h CommandLineToArgvW" + c_CommandLineToArgvW :: CWString -> Ptr CInt -> IO (Ptr CWString) + +foreign import WINDOWS_CCONV unsafe "windows.h LocalFree" + localFree :: Ptr a -> IO (Ptr a) + +mkArgs :: String -> IO [String] +mkArgs [] = return [] +mkArgs arg = + do withCWString arg $ \c_arg -> do + alloca $ \c_size -> do + res <- c_CommandLineToArgvW c_arg c_size + size <- peek c_size + args <- peekArray (fromIntegral size) res + values <- mapM peekCWString args + _ <- localFree res + return values + +execProg :: String -> Maybe FilePath -> [String] -> IO [String] +execProg prog m_stdin args = + do args' <- fmap concat $ mapM mkArgs args + prog' <- mkArgs prog + let full@(c_prog:c_args) = prog' ++ args' + -- print the commands we're executing for debugging and transparency + putStrLn $ unwords $ full ++ [maybe "" ("< " ++) m_stdin] + cwdir <- getCurrentDirectory + let cp = (proc c_prog c_args) + { std_out = CreatePipe, cwd = Just cwdir } + cp' <- case m_stdin of + Nothing -> return cp + Just path -> do h <- openFile path ReadMode + return cp{ std_in = UseHandle h} + bracket + (createProcess_ ("execProg: " ++ prog) cp') + (\(_, Just hout, _, ph) -> do + hClose hout + code <- waitForProcess ph + case std_in cp' of + UseHandle h -> hClose h + _ -> return () + case code of + ExitFailure _ -> exitWith code + ExitSuccess -> return ()) + (\(_, Just hout, _, _) -> do + results <- hGetContents hout + length results `seq` return $ lines results) + +-- | Mingw-w64's genlib.exe is generally a few order of magnitudes faster than +-- libtool which is BFD based. So we prefer it, but it's not standard so +-- support both. We're talking a difference of 45 minutes in build time here. +execLibTool :: String -> String -> IO [String] +execLibTool input_def output_lib = + do if HAS_GENLIB + then execProg genlib Nothing [input_def, "-o", output_lib] + else execProg libexe Nothing ["-d", input_def, "-l", output_lib] + +-- Builds a delay import lib at the very end which is used to +-- be able to delay the picking of a DLL on Windows. +-- This function is called always and decided internally +-- what to do. +build_delay_import_lib :: String -- ^ input def file + -> String -- ^ ouput import delayed import lib + -> String -- ^ flag to indicate if delay import + -- lib should be created + -> IO () +build_delay_import_lib input_def output_lib create_delayed + = when (isTrue create_delayed) $ + execLibTool input_def output_lib >> return () + +-- Build a normal import library from the object file definitions +build_import_lib :: FilePath -> FilePath -> FilePath -> Objs -> IO () +build_import_lib base dll_name defFile objs + = do -- Create a def file hiding symbols not in original object files + -- because --export-all is re-exporting things from static libs + -- we need to separate out data from functions. So first create two temporaries + let (globals, functions) = splitObjs objs + + -- This split is important because for DATA entries the compiler should not generate + -- a trampoline since CONTS DATA is directly referenced and not executed. This is not very + -- important for mingw-w64 which would generate both the trampoline and direct referecne + -- by default, but for libtool is it and even for mingw-w64 we can trim the output. + _ <- withFile defFile WriteMode $ \hDef -> do + hPutStrLn hDef $ unlines $ ["LIBRARY " ++ show dll_name + ,"EXPORTS" + ] + mapM_ (\v -> hPutStrLn hDef $ " " ++ show v ++ " DATA") globals + mapM_ (\v -> hPutStrLn hDef $ " " ++ show v ) functions + + let dll_import = base <.> "dll.a" + _ <- execLibTool defFile dll_import + return () + +-- Do some cleanup and create merged lib. +-- Because we have no split the DLL we need +-- to provide a way for the linker to know about the split +-- DLL. Also the compile was supposed to produce a DLL +-- foo.dll and import library foo.lib. However we've actually +-- produced foo-pt1.dll, foo-pt2.dll etc. What we don't want is to have +-- To somehow convey back to the compiler that we split the DLL in x pieces +-- as this would require a lot of changes. +-- +-- Instead we produce a merged import library which contains the union of +-- all the import libraries produced. This works because import libraries contain +-- only .idata section which point to the right dlls. So LD will do the right thing. +-- And this means we don't have to do any special handling for the rest of the pipeline. +create_merged_archive :: FilePath -> String -> Int -> IO () +create_merged_archive base prefix count + = do let ar_script = base <.> "mri" + imp_lib = base <.> "dll.a" + imp_libs = map (\i -> prefix ++ show i <.> "dll.a") [1..count] + let script = [ "create " ++ imp_lib ] ++ + map ("addlib " ++) imp_libs ++ + [ "save", "end" ] + writeFile ar_script (unlines script) + _ <- execProg ar (Just ar_script) ["-M"] + return () diff --git a/utils/mkUserGuidePart/Makefile b/utils/gen-dll/Makefile index 6664830cce..8b17a7ec76 100644 --- a/utils/mkUserGuidePart/Makefile +++ b/utils/gen-dll/Makefile @@ -10,6 +10,6 @@ # # ----------------------------------------------------------------------------- -dir = utils/mkUserGuidePart +dir = utils/gen-dll TOP = ../.. include $(TOP)/mk/sub-makefile.mk diff --git a/utils/gen-dll/gen-dll.cabal.in b/utils/gen-dll/gen-dll.cabal.in new file mode 100644 index 0000000000..4dd7dc5e8c --- /dev/null +++ b/utils/gen-dll/gen-dll.cabal.in @@ -0,0 +1,37 @@ +-- WARNING: gen-dll.cabal is automatically generated from gen-dll.cabal.in by +-- ./configure. Make sure you are editing gen-dll.cabal.in, not gen-dll.cabal. + +Name: gen-dll +Version: 0.1 +Copyright: XXX +License: BSD3 +-- XXX License-File: LICENSE +Maintainer: ghc-devs@haskell.org +author: Tamar Christina +Synopsis: Generate GHC core boot library dlls +Description: + This package is responsible for building DLLs that are delay loaded and + create optimized import libraries that can be used to delay load DLLs. + Particularly the RTS. This allows us to delay the loading of the DLL while + still having const data imports work. It also allows us to work around + certain dlltool limitations and the very slow BFD import lib implementation. + +build-type: Simple +cabal-version: >=1.10 + +Executable gen-dll + Default-Language: Haskell2010 + Main-Is: Main.hs + Build-Depends: base >= 3 && < 5 , + pretty >= 1.1 && < 1.2, + process >= 1.2 && < 1.9, + filepath >= 1.3 && < 1.5, + directory >= 1.1 && < 1.4, + containers >= 0.5 && < 0.6 + Extra-Libraries: Shell32 + ghc-options: -UGEN_SXS + -DHAS_GENLIB=@HAVE_GENLIB@ + -DNM_TOOL_BIN="\"@NmCmd@\"" + -DLIB_TOOL_BIN="\"@LibtoolCmd@\"" + -DGENLIB_TOOL_BIN="\"@GenlibCmd@\"" + -DAR_TOOL_BIN="\"@ArCmd@\"" diff --git a/utils/gen-dll/ghc.mk b/utils/gen-dll/ghc.mk new file mode 100644 index 0000000000..5b4ba3a398 --- /dev/null +++ b/utils/gen-dll/ghc.mk @@ -0,0 +1,19 @@ +# ----------------------------------------------------------------------------- +# +# (c) 2009 The University of Glasgow +# +# This file is part of the GHC build system. +# +# To understand how the build system works and how to modify it, see +# http://ghc.haskell.org/trac/ghc/wiki/Building/Architecture +# http://ghc.haskell.org/trac/ghc/wiki/Building/Modifying +# +# ----------------------------------------------------------------------------- + +utils/gen-dll_USES_CABAL = YES +utils/gen-dll_PACKAGE = gen-dll +utils/gen-dll_dist_PROGNAME = gen-dll +utils/gen-dll_dist_INSTALL = NO +utils/gen-dll_dist_INSTALL_INPLACE = YES + +$(eval $(call build-prog,utils/gen-dll,dist,0)) diff --git a/utils/genapply/Main.hs b/utils/genapply/Main.hs index 90ae5d7ac0..b30c9f8c46 100644 --- a/utils/genapply/Main.hs +++ b/utils/genapply/Main.hs @@ -19,6 +19,10 @@ module Main(main) where -- Needed for TAG_BITS #include "../../includes/MachDeps.h" +#if MIN_VERSION_base(4,11,0) +import Prelude hiding ((<>)) +#endif + import Text.PrettyPrint import Data.Word import Data.Bits @@ -854,7 +858,7 @@ genApplyFast regstatus args = nest 4 (vcat [ text "Sp_adj" <> parens (int (-sp_offset)) <> semi, saveRegOffs reg_locs, - mkJump regstatus fun_ret_label [] [] <> semi + mkJump regstatus fun_ret_label [] args <> semi ]), char '}' ]), diff --git a/utils/genprimopcode/Main.hs b/utils/genprimopcode/Main.hs index 07eab0dacb..c409050250 100644 --- a/utils/genprimopcode/Main.hs +++ b/utils/genprimopcode/Main.hs @@ -263,7 +263,7 @@ gen_hs_source (Info defaults entries) = ++ "default ()" -- If we don't say this then the default type include Integer -- so that runs off and loads modules that are not part of - -- pacakge ghc-prim at all. And that in turn somehow ends up + -- package ghc-prim at all. And that in turn somehow ends up -- with Declaration for $fEqMaybe: -- attempting to use module ‘GHC.Classes’ -- (libraries/ghc-prim/./GHC/Classes.hs) which is not loaded diff --git a/utils/ghc-cabal/Main.hs b/utils/ghc-cabal/Main.hs index 8a1c2c1755..8b776499fd 100644 --- a/utils/ghc-cabal/Main.hs +++ b/utils/ghc-cabal/Main.hs @@ -6,9 +6,8 @@ import qualified Distribution.ModuleName as ModuleName import Distribution.PackageDescription import Distribution.PackageDescription.Check hiding (doesFileExist) import Distribution.PackageDescription.Configuration -import Distribution.PackageDescription.Parse +import Distribution.PackageDescription.Parsec import Distribution.Package -import Distribution.System import Distribution.Simple import Distribution.Simple.Configure import Distribution.Simple.LocalBuildInfo @@ -16,7 +15,8 @@ import Distribution.Simple.GHC import Distribution.Simple.Program import Distribution.Simple.Program.HcPkg import Distribution.Simple.Setup (ConfigFlags(configStripLibs), fromFlag, toFlag) -import Distribution.Simple.Utils (defaultPackageDesc, writeFileAtomic, toUTF8) +import Distribution.Simple.Utils (defaultPackageDesc, findHookedPackageDesc, writeFileAtomic, + toUTF8LBS) import Distribution.Simple.Build (writeAutogenFiles) import Distribution.Simple.Register import Distribution.Text @@ -27,7 +27,7 @@ import qualified Distribution.Simple.PackageIndex as PackageIndex import Control.Exception (bracket) import Control.Monad -import qualified Data.ByteString.Lazy.Char8 as BS +import Control.Applicative ((<|>)) import Data.List import Data.Maybe import System.IO @@ -57,8 +57,8 @@ main = do hSetBuffering stdout LineBuffering doRegister dir distDir ghc ghcpkg topdir myDestDir myPrefix myLibdir myDocdir relocatableBuild args' - "configure" : dir : distDir : dll0Modules : config_args -> - generate dir distDir dll0Modules config_args + "configure" : dir : distDir : config_args -> + generate dir distDir config_args "sdist" : dir : distDir : [] -> doSdist dir distDir ["--version"] -> @@ -67,7 +67,7 @@ main = do hSetBuffering stdout LineBuffering syntax_error :: [String] syntax_error = - ["syntax: ghc-cabal configure <directory> <distdir> <dll0modules> <args>...", + ["syntax: ghc-cabal configure <directory> <distdir> <args>...", " ghc-cabal copy <directory> <distdir> <strip> <destdir> <prefix> <libdir> <docdir> <libways> <args>...", " ghc-cabal register <directory> <distdir> <ghc> <ghcpkg> <topdir> <destdir> <prefix> <libdir> <docdir> <relocatable> <args>...", " ghc-cabal hscolour <directory> <distdir> <args>...", @@ -94,13 +94,13 @@ runDefaultMain :: IO () runDefaultMain = do let verbosity = normal gpdFile <- defaultPackageDesc verbosity - gpd <- readPackageDescription verbosity gpdFile + gpd <- readGenericPackageDescription verbosity gpdFile case buildType (flattenPackageDescription gpd) of - Just Configure -> defaultMainWithHooks autoconfUserHooks + Configure -> defaultMainWithHooks autoconfUserHooks -- time has a "Custom" Setup.hs, but it's actually Configure -- plus a "./Setup test" hook. However, Cabal is also -- "Custom", but doesn't have a configure script. - Just Custom -> + Custom -> do configureExists <- doesFileExist "configure" if configureExists then defaultMainWithHooks autoconfUserHooks @@ -119,7 +119,7 @@ doCheck directory = withCurrentDirectory directory $ do let verbosity = normal gpdFile <- defaultPackageDesc verbosity - gpd <- readPackageDescription verbosity gpdFile + gpd <- readGenericPackageDescription verbosity gpdFile case filter isFailure $ checkPackage gpd Nothing of [] -> return () errs -> mapM_ print errs >> exitWith (ExitFailure 1) @@ -146,26 +146,12 @@ doCopy directory distDir else ["--destdir", myDestDir]) ++ args copyHooks = userHooks { - copyHook = noGhcPrimHook - $ modHook False + copyHook = modHook False $ copyHook userHooks } defaultMainWithHooksArgs copyHooks copyArgs where - noGhcPrimHook f pd lbi us flags - = let pd' - | packageName pd == mkPackageName "ghc-prim" = - case library pd of - Just lib -> - let ghcPrim = fromJust (simpleParse "GHC.Prim") - ems = filter (ghcPrim /=) (exposedModules lib) - lib' = lib { exposedModules = ems } - in pd { library = Just lib' } - Nothing -> - error "Expected a library, but none found" - | otherwise = pd - in f pd' lbi us flags modHook relocatableBuild f pd lbi us flags = do let verbosity = normal idts = updateInstallDirTemplates relocatableBuild @@ -265,28 +251,8 @@ updateInstallDirTemplates relocatableBuild myPrefix myLibdir myDocdir idts htmldir = toPathTemplate "$docdir" } --- On Windows we need to split the ghc package into 2 pieces, or the --- DLL that it makes contains too many symbols (#5987). There are --- therefore 2 libraries, not just the 1 that Cabal assumes. -mangleIPI :: FilePath -> FilePath -> LocalBuildInfo - -> Installed.InstalledPackageInfo -> Installed.InstalledPackageInfo -mangleIPI "compiler" "stage2" lbi ipi - | isWindows = - -- Cabal currently only ever installs ONE Haskell library, c.f. - -- the code in Cabal.Distribution.Simple.Register. If it - -- ever starts installing more we'll have to find the - -- library that's too big and split that. - let [old_hslib] = Installed.hsLibraries ipi - in ipi { - Installed.hsLibraries = [old_hslib, old_hslib ++ "-0"] - } - where isWindows = case hostPlatform lbi of - Platform _ Windows -> True - _ -> False -mangleIPI _ _ _ ipi = ipi - -generate :: FilePath -> FilePath -> String -> [String] -> IO () -generate directory distdir dll0Modules config_args +generate :: FilePath -> FilePath -> [String] -> IO () +generate directory distdir config_args = withCurrentDirectory directory $ do let verbosity = normal -- XXX We shouldn't just configure with the default flags @@ -301,9 +267,15 @@ generate directory distdir dll0Modules config_args writePersistBuildConfig distdir lbi hooked_bi <- - if (buildType pd0 == Just Configure) || (buildType pd0 == Just Custom) + if (buildType pd0 == Configure) || (buildType pd0 == Custom) then do - maybe_infoFile <- defaultHookedPackageDesc + cwd <- getCurrentDirectory + -- Try to find the .buildinfo in the $dist/build folder where + -- cabal 2.2+ will expect it, but fallback to the old default + -- location if we don't find any. This is the case of the + -- bindist, which doesn't ship the $dist/build folder. + maybe_infoFile <- findHookedPackageDesc (cwd </> distdir </> "build") + <|> defaultHookedPackageDesc case maybe_infoFile of Nothing -> return emptyHookedBuildInfo Just infoFile -> readHookedBuildInfo verbosity infoFile @@ -319,16 +291,19 @@ generate directory distdir dll0Modules config_args -- generate inplace-pkg-config withLibLBI pd lbi $ \lib clbi -> do cwd <- getCurrentDirectory + let fixupIncludeDir dir | cwd `isPrefixOf` dir = [dir, cwd </> distdir </> "build" ++ drop (length cwd) dir] + | otherwise = [dir] let ipid = mkUnitId (display (packageId pd)) let installedPkgInfo = inplaceInstalledPackageInfo cwd distdir pd (mkAbiHash "inplace") lib lbi clbi - final_ipi = mangleIPI directory distdir lbi $ installedPkgInfo { + final_ipi = installedPkgInfo { Installed.installedUnitId = ipid, Installed.compatPackageKey = display (packageId pd), - Installed.haddockHTMLs = [] + Installed.includeDirs = concatMap fixupIncludeDir (Installed.includeDirs installedPkgInfo) } content = Installed.showInstalledPackageInfo final_ipi ++ "\n" - writeFileAtomic (distdir </> "inplace-pkg-config") (BS.pack $ toUTF8 content) + writeFileAtomic (distdir </> "inplace-pkg-config") + (toUTF8LBS content) let comp = compiler lbi @@ -403,12 +378,20 @@ generate directory distdir dll0Modules config_args mkLibraryRelDir "Cabal" = "libraries/Cabal/Cabal/dist-install/build" mkLibraryRelDir l = "libraries/" ++ l ++ "/dist-install/build" libraryRelDirs = map mkLibraryRelDir transitiveDepNames - wrappedIncludeDirs <- wrap $ forDeps Installed.includeDirs + + -- this is a hack to accommodate Cabal 2.2+ more hygenic + -- generated data. We'll inject `dist-install/build` after + -- before the `include` directory, if any. + injectDistInstall :: FilePath -> [FilePath] + injectDistInstall x | takeBaseName x == "include" = [x, takeDirectory x ++ "/dist-install/build/" ++ takeBaseName x] + injectDistInstall x = [x] + + wrappedIncludeDirs <- wrap $ concatMap injectDistInstall $ forDeps Installed.includeDirs let variablePrefix = directory ++ '_':distdir mods = map display modules otherMods = map display (otherModules bi) - allMods = mods ++ otherMods + buildDir' = map (\c -> if c=='\\' then '/' else c) $ buildDir lbi let xs = [variablePrefix ++ "_VERSION = " ++ display (pkgVersion (package pd)), -- TODO: move inside withLibLBI variablePrefix ++ "_COMPONENT_ID = " ++ localCompatPackageKey lbi, @@ -422,13 +405,16 @@ generate directory distdir dll0Modules config_args variablePrefix ++ "_DEP_COMPONENT_IDS = " ++ unwords depLibNames, variablePrefix ++ "_TRANSITIVE_DEP_NAMES = " ++ unwords transitiveDepNames, variablePrefix ++ "_TRANSITIVE_DEP_COMPONENT_IDS = " ++ unwords transitiveDepLibNames, - variablePrefix ++ "_INCLUDE_DIRS = " ++ unwords (includeDirs bi), + variablePrefix ++ "_INCLUDE_DIRS = " ++ unwords ( [ dir | dir <- includeDirs bi ] + ++ [ buildDir' ++ "/" ++ dir | dir <- includeDirs bi + , not (isAbsolute dir)]), variablePrefix ++ "_INCLUDES = " ++ unwords (includes bi), variablePrefix ++ "_INSTALL_INCLUDES = " ++ unwords (installIncludes bi), variablePrefix ++ "_EXTRA_LIBRARIES = " ++ unwords (extraLibs bi), variablePrefix ++ "_EXTRA_LIBDIRS = " ++ unwords (extraLibDirs bi), + variablePrefix ++ "_S_SRCS = " ++ unwords (asmSources bi), variablePrefix ++ "_C_SRCS = " ++ unwords (cSources bi), - variablePrefix ++ "_CMM_SRCS := $(addprefix cbits/,$(notdir $(wildcard " ++ directory ++ "/cbits/*.cmm)))", + variablePrefix ++ "_CMM_SRCS = " ++ unwords (cmmSources bi), variablePrefix ++ "_DATA_FILES = " ++ unwords (dataFiles pd), -- XXX This includes things it shouldn't, like: -- -odir dist-bootstrapping/build @@ -458,11 +444,6 @@ generate directory distdir dll0Modules config_args writeFileUtf8 (distdir ++ "/haddock-prologue.txt") $ if null (description pd) then synopsis pd else description pd - unless (null dll0Modules) $ - do let dll0Mods = words dll0Modules - dllMods = allMods \\ dll0Mods - dllModSets = map unwords [dll0Mods, dllMods] - writeFile (distdir ++ "/dll-split") $ unlines dllModSets where escape = foldr (\c xs -> if c == '#' then '\\':'#':xs else c:xs) [] wrap = mapM wrap1 diff --git a/utils/ghc-cabal/cabal_macros_boot.h b/utils/ghc-cabal/cabal_macros_boot.h deleted file mode 100644 index 3b130e844c..0000000000 --- a/utils/ghc-cabal/cabal_macros_boot.h +++ /dev/null @@ -1,40 +0,0 @@ -/* defines a few MIN_VERSION_...() macros used by some of the bootstrap packages */ - -#if __GLASGOW_HASKELL__ >= 800 -/* macros are generated accurately by GHC on the fly */ -#elif __GLASGOW_HASKELL__ >= 711 -/* package base-4.9.0.0 */ -# define MIN_VERSION_base(major1,major2,minor) (\ - (major1) < 4 || \ - (major1) == 4 && (major2) < 9 || \ - (major1) == 4 && (major2) == 9 && (minor) <= 0) -/* package bytestring-0.10.8 */ -# define MIN_VERSION_bytestring(major1,major2,minor) (\ - (major1) < 0 || \ - (major1) == 0 && (major2) < 10 || \ - (major1) == 0 && (major2) == 10 && (minor) <= 8) - -#elif __GLASGOW_HASKELL__ >= 709 -/* package base-4.8.0.0 */ -# define MIN_VERSION_base(major1,major2,minor) (\ - (major1) < 4 || \ - (major1) == 4 && (major2) < 8 || \ - (major1) == 4 && (major2) == 8 && (minor) <= 0) -/* package bytestring-0.10.6 */ -# define MIN_VERSION_bytestring(major1,major2,minor) (\ - (major1) < 0 || \ - (major1) == 0 && (major2) < 10 || \ - (major1) == 0 && (major2) == 10 && (minor) <= 6) - -#elif __GLASGOW_HASKELL__ >= 707 -/* package base-4.7.0 */ -# define MIN_VERSION_base(major1,major2,minor) (\ - (major1) < 4 || \ - (major1) == 4 && (major2) < 7 || \ - (major1) == 4 && (major2) == 7 && (minor) <= 0) -/* package bytestring-0.10.4 */ -# define MIN_VERSION_bytestring(major1,major2,minor) (\ - (major1) < 0 || \ - (major1) == 0 && (major2) < 10 || \ - (major1) == 0 && (major2) == 10 && (minor) <= 4) -#endif diff --git a/utils/ghc-cabal/ghc-cabal.cabal b/utils/ghc-cabal/ghc-cabal.cabal index 2c20432b5f..baa7a1702a 100644 --- a/utils/ghc-cabal/ghc-cabal.cabal +++ b/utils/ghc-cabal/ghc-cabal.cabal @@ -21,7 +21,7 @@ Executable ghc-cabal Build-Depends: base >= 3 && < 5, bytestring >= 0.10 && < 0.11, - Cabal >= 2.0 && < 2.1, + Cabal >= 2.4 && < 2.5, directory >= 1.1 && < 1.4, filepath >= 1.2 && < 1.5 diff --git a/utils/ghc-cabal/ghc.mk b/utils/ghc-cabal/ghc.mk index 6250484017..70e418eaf6 100644 --- a/utils/ghc-cabal/ghc.mk +++ b/utils/ghc-cabal/ghc.mk @@ -19,17 +19,13 @@ CABAL_VERSION := $(subst .,$(comma),$(CABAL_DOTTED_VERSION)) CABAL_CONSTRAINT := --constraint="Cabal == $(CABAL_DOTTED_VERSION)" # Starting with GHC 8.0 we make use of GHC's native ability to -# generate MIN_VERSION_<pkgname>() CPP macros (rather than relying on -# the fragile `cabal_macros_boot.h` hack). The generation of those +# generate MIN_VERSION_<pkgname>() CPP macros. The generation of those # macros is triggered by `-hide-all-packages`, so we have to explicitly -# enumerate all packages we need in scope. In order to simplify the logic, -# we pass `-hide-all-packages` also to GHCs < 8, and we include -# `cabal_macros_boot.h` also for GHC >= 8 (in which case it becomes a -# dummy include that doesn't contribute any macro definitions). +# enumerate all packages we need in scope. ifeq "$(Windows_Host)" "YES" -CABAL_BUILD_DEPS := base array time containers bytestring deepseq process pretty directory Win32 +CABAL_BUILD_DEPS := ghc-prim base array transformers time containers bytestring deepseq process pretty directory Win32 else -CABAL_BUILD_DEPS := base array time containers bytestring deepseq process pretty directory unix +CABAL_BUILD_DEPS := ghc-prim base array transformers time containers bytestring deepseq process pretty directory unix endif ghc-cabal_DIST_BINARY_NAME = ghc-cabal$(exeext0) @@ -40,11 +36,23 @@ ifneq "$(BINDIST)" "YES" $(ghc-cabal_INPLACE) : $(ghc-cabal_DIST_BINARY) | $$(dir $$@)/. "$(CP)" $< $@ +# Minor hack, since we can't reuse the `hs-suffix-rules-srcdir` macro +ifneq ($(wildcard libraries/Cabal/Cabal/Distribution/Parsec/Lexer.x),) +# Lexer.x exists so we have to call Alex ourselves +CABAL_LEXER_DEP := bootstrapping/Cabal/Distribution/Parsec/Lexer.hs + +bootstrapping/Cabal/Distribution/Parsec/Lexer.hs: libraries/Cabal/Cabal/Distribution/Parsec/Lexer.x + mkdir -p bootstrapping/Cabal/Distribution/Parsec + $(call cmd,ALEX) $< -o $@ +else +CABAL_LEXER_DEP := libraries/Cabal/Cabal/Distribution/Parsec/Lexer.hs +endif + $(ghc-cabal_DIST_BINARY): $(wildcard libraries/Cabal/Cabal/Distribution/*/*/*.hs) $(ghc-cabal_DIST_BINARY): $(wildcard libraries/Cabal/Cabal/Distribution/*/*.hs) $(ghc-cabal_DIST_BINARY): $(wildcard libraries/Cabal/Cabal/Distribution/*.hs) -$(ghc-cabal_DIST_BINARY): utils/ghc-cabal/Main.hs $(TOUCH_DEP) | $$(dir $$@)/. bootstrapping/. +$(ghc-cabal_DIST_BINARY): $(CABAL_LEXER_DEP) utils/ghc-cabal/Main.hs $(TOUCH_DEP) | $$(dir $$@)/. bootstrapping/. "$(GHC)" $(SRC_HC_OPTS) \ $(addprefix -optc, $(SRC_CC_OPTS) $(CONF_CC_OPTS_STAGE0)) \ $(addprefix -optl, $(SRC_LD_OPTS) $(CONF_GCC_LINKER_OPTS_STAGE0)) \ @@ -54,14 +62,20 @@ $(ghc-cabal_DIST_BINARY): utils/ghc-cabal/Main.hs $(TOUCH_DEP) | $$(dir $$@)/. b -no-user-$(GHC_PACKAGE_DB_FLAG) \ -Wall -fno-warn-unused-imports -fno-warn-warnings-deprecations \ -DCABAL_VERSION=$(CABAL_VERSION) \ + -DCABAL_PARSEC \ -DBOOTSTRAPPING \ - -optP-include -optPutils/ghc-cabal/cabal_macros_boot.h \ -odir bootstrapping \ -hidir bootstrapping \ + $(CABAL_LEXER_DEP) \ -ilibraries/Cabal/Cabal \ -ilibraries/binary/src \ -ilibraries/filepath \ -ilibraries/hpc \ + -ilibraries/mtl \ + -ilibraries/text \ + libraries/text/cbits/cbits.c \ + -Ilibraries/text/include \ + -ilibraries/parsec/src \ $(utils/ghc-cabal_dist_EXTRA_HC_OPTS) \ $(EXTRA_HC_OPTS) "$(TOUCH_CMD)" $@ diff --git a/utils/ghc-in-ghci/inner.ghci b/utils/ghc-in-ghci/inner.ghci new file mode 100644 index 0000000000..72834c96b5 --- /dev/null +++ b/utils/ghc-in-ghci/inner.ghci @@ -0,0 +1 @@ +:set prompt "%s [inner]> " diff --git a/utils/ghc-in-ghci/load-main.ghci b/utils/ghc-in-ghci/load-main.ghci new file mode 100644 index 0000000000..a79855744e --- /dev/null +++ b/utils/ghc-in-ghci/load-main.ghci @@ -0,0 +1 @@ +:load Main diff --git a/utils/ghc-in-ghci/run.sh b/utils/ghc-in-ghci/run.sh new file mode 100755 index 0000000000..521458f67d --- /dev/null +++ b/utils/ghc-in-ghci/run.sh @@ -0,0 +1,34 @@ +#!/bin/sh -xe + +# Runs ghc-stage2 with GHCi settings that allow GHC to be loaded and run in the +# interpreter. Options provided on the command-line will be passed directly to +# the GHCi invocation. + +# Note that this script is intended to be run from the root of the GHC repo, +# like this: + +# ./utils/ghc-in-ghci/run.sh + +# This is substantially faster than doing an actual compile, and so can aid in +# tighter development iterations. It can be made even faster by specifying "-jN" +# for parallelism. Typically choosing an N value close to the number of logical +# CPU cores you have leads to faster loads. Here's how to specify -j: + +# ./utils/ghc-in-ghci/run.sh -j4 + +# The script will also run `:load Main`, to load GHC's main module. After that, +# running `main` will run an inner GHCi, because there is a default `:set args +# --interactive ...`. To override this, use `:set args ...` or `:main ...`. + +# If you don't want to wait for `:load Main`, since you want to load some other +# module, then you can use `Ctrl+C` to cancel the initial load. + + +export _GHC_TOP_DIR=./inplace/lib + +exec ./inplace/bin/ghc-stage2 \ + --interactive \ + -ghci-script ./utils/ghc-in-ghci/settings.ghci \ + -ghci-script ./utils/ghc-in-ghci/load-main.ghci \ + +RTS -A128m -RTS \ + "$@" diff --git a/utils/ghc-in-ghci/settings.ghci b/utils/ghc-in-ghci/settings.ghci new file mode 100644 index 0000000000..dd914d1491 --- /dev/null +++ b/utils/ghc-in-ghci/settings.ghci @@ -0,0 +1,63 @@ +:set -icompiler/backpack +:set -icompiler/basicTypes +:set -icompiler/cmm +:set -icompiler/codeGen +:set -icompiler/coreSyn +:set -icompiler/deSugar +:set -icompiler/ghci +:set -icompiler/hsSyn +:set -icompiler/iface +:set -icompiler/llvmGen +:set -icompiler/main +:set -icompiler/nativeGen +:set -icompiler/parser +:set -icompiler/prelude +:set -icompiler/profiling +:set -icompiler/rename +:set -icompiler/simplCore +:set -icompiler/simplStg +:set -icompiler/specialise +:set -icompiler/stgSyn +:set -icompiler/stranal +:set -icompiler/typecheck +:set -icompiler/types +:set -icompiler/utils +:set -icompiler/vectorise +:set -ighc +:set -Icompiler +:set -Iincludes +:set -Iincludes/dist-derivedconstants/header +:set -package=ghc-boot-th +:set -DSTAGE=2 +:set -DGHCI +:set -DGHC_LOADED_INTO_GHCI +:set -XNoImplicitPrelude + +-- make it work for Make stage2 +:set -Icompiler/stage2 +:set -Icompiler/stage2/build +:set -icompiler/stage2/build + +-- make it work for Make stage1 +:set -Icompiler/stage1 +:set -Icompiler/stage1/build +:set -icompiler/stage1/build + +-- make it work for Hadrian stage2 +:set -I_build/generated +:set -I_build/stage2/compiler/build +:set -i_build/stage2/compiler/build + +-- make it work for Hadrian stage1 +:set -I_build/stage1/compiler/build +:set -i_build/stage1/compiler/build + +-- -fobject-code is required because bytecode doesn't support unboxed tuples +-- https://ghc.haskell.org/trac/ghc/ticket/1257 +:set -odir ./.ghci-objects +:set -hidir ./.ghci-objects +:set -fobject-code + +-- Setup args so that running "main" will run ghci and set the prompt to +-- indicate that it is an inner ghci. +:set args --interactive -ghci-script utils/ghc-in-ghci/inner.ghci diff --git a/utils/ghc-pkg/Main.hs b/utils/ghc-pkg/Main.hs index 9074acfd4c..3aa4186db4 100644 --- a/utils/ghc-pkg/Main.hs +++ b/utils/ghc-pkg/Main.hs @@ -17,6 +17,24 @@ #endif #endif +-- The SIMPLE_WIN_GETLIBDIR macro will only be set when +-- building on windows. +-- +-- Its purpose is to let us know whether the Windows implementation of +-- 'getExecutablePath' follows symlinks or not (it does follow them in +-- base >= 4.11). If it does, the implementation of getLibDir is straightforward +-- but if it does not follow symlinks, we need to follow them ourselves here. +-- Once we do not have to support building ghc-pkg with base < 4.11 anymore, +-- we can keep only the simple, straightforward implementation that just uses +-- 'getExecutablePath'. +#if defined(mingw32_HOST_OS) +#if MIN_VERSION_base(4,11,0) +#define SIMPLE_WIN_GETLIBDIR 1 +#else +#define SIMPLE_WIN_GETLIBDIR 0 +#endif +#endif + ----------------------------------------------------------------------------- -- -- (c) The University of Glasgow 2004-2009. @@ -30,6 +48,7 @@ module Main (main) where import Version ( version, targetOS, targetARCH ) import qualified GHC.PackageDb as GhcPkg import GHC.PackageDb (BinaryStringRep(..)) +import GHC.HandleEncoding import qualified Distribution.Simple.PackageIndex as PackageIndex import qualified Data.Graph as Graph import qualified Distribution.ModuleName as ModuleName @@ -44,7 +63,7 @@ import Distribution.Backpack import Distribution.Types.UnqualComponentName import Distribution.Types.MungedPackageName import Distribution.Types.MungedPackageId -import Distribution.Simple.Utils (fromUTF8, toUTF8, writeUTF8File, readUTF8File) +import Distribution.Simple.Utils (fromUTF8BS, toUTF8BS, writeUTF8File, readUTF8File) import qualified Data.Version as Version import System.FilePath as FilePath import qualified System.FilePath.Posix as FilePath.Posix @@ -65,6 +84,9 @@ import System.Directory ( doesDirectoryExist, getDirectoryContents, getCurrentDirectory ) import System.Exit ( exitWith, ExitCode(..) ) import System.Environment ( getArgs, getProgName, getEnv ) +#if defined(darwin_HOST_OS) || defined(linux_HOST_OS) || SIMPLE_WIN_GETLIBDIR +import System.Environment ( getExecutablePath ) +#endif import System.IO import System.IO.Error import GHC.IO.Exception (IOErrorType(InappropriateType)) @@ -75,13 +97,13 @@ import qualified Data.Traversable as F import qualified Data.Set as Set import qualified Data.Map as Map -import qualified Data.ByteString.Char8 as BS - #if defined(mingw32_HOST_OS) --- mingw32 needs these for getExecDir +#if !SIMPLE_WIN_GETLIBDIR +-- mingw32 needs these for getExecDir when base < 4.11 import Foreign import Foreign.C import System.Directory ( canonicalizePath ) +#endif import GHC.ConsoleHandler #else import System.Posix hiding (fdToHandle) @@ -119,6 +141,7 @@ anyM p (x:xs) = do main :: IO () main = do + configureHandleEncoding args <- getArgs case getOpt Permute (flags ++ deprecFlags) args of @@ -270,8 +293,8 @@ usageHeader prog = substProg prog $ "\n" ++ " $p dot\n" ++ " Generate a graph of the package dependencies in a form suitable\n" ++ - " for input for the graphviz tools. For example, to generate a PDF" ++ - " of the dependency graph: ghc-pkg dot | tred | dot -Tpdf >pkgs.pdf" ++ + " for input for the graphviz tools. For example, to generate a PDF\n" ++ + " of the dependency graph: ghc-pkg dot | tred | dot -Tpdf >pkgs.pdf\n" ++ "\n" ++ " $p find-module {module}\n" ++ " List registered packages exposing module {module} in the global\n" ++ @@ -574,6 +597,15 @@ data DbModifySelector = TopOne | ContainsPkg PackageArg allPackagesInStack :: PackageDBStack -> [InstalledPackageInfo] allPackagesInStack = concatMap packages +-- | Retain only the part of the stack up to and including the given package +-- DB (where the global package DB is the bottom of the stack). The resulting +-- package DB stack contains exactly the packages that packages from the +-- specified package DB can depend on, since dependencies can only extend +-- down the stack, not up (e.g. global packages cannot depend on user +-- packages). +stackUpTo :: FilePath -> PackageDBStack -> PackageDBStack +stackUpTo to_modify = dropWhile ((/= to_modify) . location) + getPkgDatabases :: Verbosity -> GhcPkg.DbOpenMode mode DbModifySelector -> Bool -- use the user db @@ -1074,6 +1106,10 @@ initPackageDB filename verbosity _flags = do packageDbLock = GhcPkg.DbOpenReadWrite lock, packages = [] } + -- We can get away with passing an empty stack here, because the new DB is + -- going to be initially empty, so no dependencies are going to be actually + -- looked up. + [] -- ----------------------------------------------------------------------------- -- Registering @@ -1123,7 +1159,7 @@ registerPackage input verbosity my_flags multi_instance let top_dir = takeDirectory (location (last db_stack)) pkg_expanded = mungePackagePaths top_dir pkgroot pkg - let truncated_stack = dropWhile ((/= to_modify).location) db_stack + let truncated_stack = stackUpTo to_modify db_stack -- truncate the stack for validation, because we don't allow -- packages lower in the stack to refer to those higher up. validatePackageConfig pkg_expanded verbosity truncated_stack @@ -1141,7 +1177,7 @@ registerPackage input verbosity my_flags multi_instance -- Only remove things that were instantiated the same way! instantiatedWith p == instantiatedWith pkg ] -- - changeDB verbosity (removes ++ [AddPackage pkg]) db_to_operate_on + changeDB verbosity (removes ++ [AddPackage pkg]) db_to_operate_on db_stack parsePackageInfo :: String @@ -1166,12 +1202,16 @@ data DBOp = RemovePackage InstalledPackageInfo | AddPackage InstalledPackageInfo | ModifyPackage InstalledPackageInfo -changeDB :: Verbosity -> [DBOp] -> PackageDB 'GhcPkg.DbReadWrite -> IO () -changeDB verbosity cmds db = do +changeDB :: Verbosity + -> [DBOp] + -> PackageDB 'GhcPkg.DbReadWrite + -> PackageDBStack + -> IO () +changeDB verbosity cmds db db_stack = do let db' = updateInternalDB db cmds db'' <- adjustOldFileStylePackageDB db' createDirectoryIfMissing True (location db'') - changeDBDir verbosity cmds db'' + changeDBDir verbosity cmds db'' db_stack updateInternalDB :: PackageDB 'GhcPkg.DbReadWrite -> [DBOp] -> PackageDB 'GhcPkg.DbReadWrite @@ -1184,10 +1224,14 @@ updateInternalDB db cmds = db{ packages = foldl do_cmd (packages db) cmds } do_cmd (do_cmd pkgs (RemovePackage p)) (AddPackage p) -changeDBDir :: Verbosity -> [DBOp] -> PackageDB 'GhcPkg.DbReadWrite -> IO () -changeDBDir verbosity cmds db = do +changeDBDir :: Verbosity + -> [DBOp] + -> PackageDB 'GhcPkg.DbReadWrite + -> PackageDBStack + -> IO () +changeDBDir verbosity cmds db db_stack = do mapM_ do_cmd cmds - updateDBCache verbosity db + updateDBCache verbosity db db_stack where do_cmd (RemovePackage p) = do let file = location db </> display (installedUnitId p) <.> "conf" @@ -1200,20 +1244,63 @@ changeDBDir verbosity cmds db = do do_cmd (ModifyPackage p) = do_cmd (AddPackage p) -updateDBCache :: Verbosity -> PackageDB 'GhcPkg.DbReadWrite -> IO () -updateDBCache verbosity db = do +updateDBCache :: Verbosity + -> PackageDB 'GhcPkg.DbReadWrite + -> PackageDBStack + -> IO () +updateDBCache verbosity db db_stack = do let filename = location db </> cachefilename + db_stack_below = stackUpTo (location db) db_stack pkgsCabalFormat :: [InstalledPackageInfo] pkgsCabalFormat = packages db - pkgsGhcCacheFormat :: [PackageCacheFormat] - pkgsGhcCacheFormat = map convertPackageInfoToCacheFormat pkgsCabalFormat + -- | All the packages we can legally depend on in this step. + dependablePkgsCabalFormat :: [InstalledPackageInfo] + dependablePkgsCabalFormat = allPackagesInStack db_stack_below + + pkgsGhcCacheFormat :: [(PackageCacheFormat, Bool)] + pkgsGhcCacheFormat + -- See Note [Recompute abi-depends] + = map (recomputeValidAbiDeps dependablePkgsCabalFormat) + $ map convertPackageInfoToCacheFormat + pkgsCabalFormat + + hasAnyAbiDepends :: InstalledPackageInfo -> Bool + hasAnyAbiDepends x = length (abiDepends x) > 0 + + -- warn when we find any (possibly-)bogus abi-depends fields; + -- Note [Recompute abi-depends] + when (verbosity >= Normal) $ do + let definitelyBrokenPackages = + nub + . sort + . map (unPackageName . GhcPkg.packageName . fst) + . filter snd + $ pkgsGhcCacheFormat + when (definitelyBrokenPackages /= []) $ do + warn "the following packages have broken abi-depends fields:" + forM_ definitelyBrokenPackages $ \pkg -> + warn $ " " ++ pkg + when (verbosity > Normal) $ do + let possiblyBrokenPackages = + nub + . sort + . filter (not . (`elem` definitelyBrokenPackages)) + . map (unPackageName . pkgName . packageId) + . filter hasAnyAbiDepends + $ pkgsCabalFormat + when (possiblyBrokenPackages /= []) $ do + warn $ + "the following packages have correct abi-depends, " ++ + "but may break in the future:" + forM_ possiblyBrokenPackages $ \pkg -> + warn $ " " ++ pkg when (verbosity > Normal) $ infoLn ("writing cache " ++ filename) - GhcPkg.writePackageDb filename pkgsGhcCacheFormat pkgsCabalFormat + GhcPkg.writePackageDb filename (map fst pkgsGhcCacheFormat) pkgsCabalFormat `catchIO` \e -> if isPermissionError e then die $ filename ++ ": you don't have permission to modify this file" @@ -1231,6 +1318,54 @@ type PackageCacheFormat = GhcPkg.InstalledPackageInfo ModuleName OpenModule +{- Note [Recompute abi-depends] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +Like most fields, `ghc-pkg` relies on who-ever is performing package +registration to fill in fields; this includes the `abi-depends` field present +for the package. + +However, this was likely a mistake, and is not very robust; in certain cases, +versions of Cabal may use bogus abi-depends fields for a package when doing +builds. Why? Because package database information is aggressively cached; it is +possible to work Cabal into a situation where it uses a cached version of +`abi-depends`, rather than the one in the actual database after it has been +recomputed. + +However, there is an easy fix: ghc-pkg /already/ knows the `abi-depends` of a +package, because they are the ABIs of the packages pointed at by the `depends` +field. So it can simply look up the abi from the dependencies in the original +database, and ignore whatever the system registering gave it. + +So, instead, we do two things here: + + - We throw away the information for a registered package's `abi-depends` field. + + - We recompute it: we simply look up the unit ID of the package in the original + database, and use *its* abi-depends. + +See Trac #14381, and Cabal issue #4728. + +Additionally, because we are throwing away the original (declared) ABI deps, we +return a boolean that indicates whether any abi-depends were actually +overridden. + +-} + +recomputeValidAbiDeps :: [InstalledPackageInfo] + -> PackageCacheFormat + -> (PackageCacheFormat, Bool) +recomputeValidAbiDeps db pkg = + (pkg { GhcPkg.abiDepends = newAbiDeps }, abiDepsUpdated) + where + newAbiDeps = + catMaybes . flip map (GhcPkg.abiDepends pkg) $ \(k, _) -> + case filter (\d -> installedUnitId d == k) db of + [x] -> Just (k, unAbiHash (abiHash x)) + _ -> Nothing + abiDepsUpdated = + GhcPkg.abiDepends pkg /= newAbiDeps + convertPackageInfoToCacheFormat :: InstalledPackageInfo -> PackageCacheFormat convertPackageInfoToCacheFormat pkg = GhcPkg.InstalledPackageInfo { @@ -1286,8 +1421,8 @@ instance GhcPkg.BinaryStringRep ModuleName where toStringRep = toStringRep . display instance GhcPkg.BinaryStringRep String where - fromStringRep = fromUTF8 . BS.unpack - toStringRep = BS.pack . toUTF8 + fromStringRep = fromUTF8BS + toStringRep = toUTF8BS instance GhcPkg.BinaryStringRep UnitId where fromStringRep = mkUnitId . fromStringRep @@ -1368,14 +1503,14 @@ modifyPackage fn pkgarg verbosity my_flags force = do dieOrForceAll force ("unregistering would break the following packages: " ++ unwords (map displayQualPkgId newly_broken)) - changeDB verbosity cmds db + changeDB verbosity cmds db db_stack recache :: Verbosity -> [Flag] -> IO () recache verbosity my_flags = do (_db_stack, GhcPkg.DbOpenReadWrite db_to_operate_on, _flag_dbs) <- getPkgDatabases verbosity (GhcPkg.DbOpenReadWrite TopOne) True{-use user-} False{-no cache-} False{-expand vars-} my_flags - changeDB verbosity [] db_to_operate_on + changeDB verbosity [] db_to_operate_on _db_stack -- ----------------------------------------------------------------------------- -- Listing packages @@ -2078,14 +2213,15 @@ dieForcible s = die (s ++ " (use --force to override)") ----------------------------------------- -- Cut and pasted from ghc/compiler/main/SysTools -#if defined(mingw32_HOST_OS) +getLibDir :: IO (Maybe String) + +#if defined(mingw32_HOST_OS) && !SIMPLE_WIN_GETLIBDIR subst :: Char -> Char -> String -> String subst a b ls = map (\ x -> if x == a then b else x) ls unDosifyPath :: FilePath -> FilePath unDosifyPath xs = subst '\\' '/' xs -getLibDir :: IO (Maybe String) getLibDir = do base <- getExecDir "/ghc-pkg.exe" case base of Nothing -> return Nothing @@ -2118,8 +2254,9 @@ getExecPath = try_size 2048 -- plenty, PATH_MAX is 512 under Win32. foreign import WINDOWS_CCONV unsafe "windows.h GetModuleFileNameW" c_GetModuleFileName :: Ptr () -> CWString -> Word32 -> IO Word32 +#elif SIMPLE_WIN_GETLIBDIR || defined(darwin_HOST_OS) || defined(linux_HOST_OS) +getLibDir = Just . (\p -> p </> "lib") . takeDirectory . takeDirectory <$> getExecutablePath #else -getLibDir :: IO (Maybe String) getLibDir = return Nothing #endif diff --git a/utils/ghctags/Main.hs b/utils/ghctags/Main.hs index c4db3ca212..6f5564d8ea 100644 --- a/utils/ghctags/Main.hs +++ b/utils/ghctags/Main.hs @@ -254,7 +254,7 @@ boundValues :: ModuleName -> HsGroup GhcRn -> [FoundThing] -- ^Finds all the top-level definitions in a module boundValues mod group = let vals = case hs_valds group of - ValBindsOut nest _sigs -> + XValBindsLR (NValBinds nest _sigs) -> [ x | (_rec, binds) <- nest , bind <- bagToList binds , x <- boundThings mod bind ] @@ -264,8 +264,9 @@ boundValues mod group = , n <- map found ns ] fors = concat $ map forBound (hs_fords group) where forBound lford = case unLoc lford of - ForeignImport n _ _ _ -> [found n] + ForeignImport _ n _ _ -> [found n] ForeignExport { } -> [] + XForeignDecl { } -> [] in vals ++ tys ++ fors where found = foundOfLName mod @@ -284,29 +285,28 @@ boundThings modname lbinding = PatBind { pat_lhs = lhs } -> patThings lhs [] VarBind { var_id = id } -> [FoundThing modname (getOccString id) (startOfLocated lbinding)] AbsBinds { } -> [] -- nothing interesting in a type abstraction - AbsBindsSig { } -> [] - PatSynBind PSB{ psb_id = id } -> [thing id] + PatSynBind _ PSB{ psb_id = id } -> [thing id] + PatSynBind _ (XPatSynBind _) -> [] + XHsBindsLR _ -> [] where thing = foundOfLName modname patThings lpat tl = let loc = startOfLocated lpat lid id = FoundThing modname (getOccString id) loc in case unLoc lpat of WildPat _ -> tl - VarPat (L _ name) -> lid name : tl - LazyPat p -> patThings p tl - AsPat id p -> patThings p (thing id : tl) - ParPat p -> patThings p tl - BangPat p -> patThings p tl - ListPat ps _ _ -> foldr patThings tl ps - TuplePat ps _ _ -> foldr patThings tl ps - PArrPat ps _ -> foldr patThings tl ps + VarPat _ (L _ name) -> lid name : tl + LazyPat _ p -> patThings p tl + AsPat _ id p -> patThings p (thing id : tl) + ParPat _ p -> patThings p tl + BangPat _ p -> patThings p tl + ListPat _ ps -> foldr patThings tl ps + TuplePat _ ps _ -> foldr patThings tl ps ConPatIn _ conargs -> conArgs conargs tl ConPatOut{ pat_args = conargs } -> conArgs conargs tl - LitPat _ -> tl + LitPat _ _ -> tl NPat {} -> tl -- form of literal pattern? - NPlusKPat id _ _ _ _ _ -> thing id : tl - SigPatIn p _ -> patThings p tl - SigPatOut p _ -> patThings p tl + NPlusKPat _ id _ _ _ _ -> thing id : tl + SigPat _ p -> patThings p tl _ -> error "boundThings" conArgs (PrefixCon ps) tl = foldr patThings tl ps conArgs (RecCon (HsRecFields { rec_flds = flds })) tl diff --git a/utils/ghctags/ghctags.cabal b/utils/ghctags/ghctags.cabal index 1bb658882c..f74bc4ff4a 100644 --- a/utils/ghctags/ghctags.cabal +++ b/utils/ghctags/ghctags.cabal @@ -18,6 +18,6 @@ Executable ghctags Build-Depends: base >= 4 && < 5, containers, - Cabal >= 2.0 && <2.1, + Cabal >= 2.4 && <2.5, ghc diff --git a/utils/hp2ps/hp2ps.cabal b/utils/hp2ps/hp2ps.cabal new file mode 100644 index 0000000000..b4062b2cb5 --- /dev/null +++ b/utils/hp2ps/hp2ps.cabal @@ -0,0 +1,22 @@ +cabal-version: 2.1 +Name: hp2ps +Version: 0.1 +Copyright: XXX +license: BSD-3-Clause +Author: XXX +Maintainer: XXX +Synopsis: Heap Profile to PostScript converter +Description: XXX +Category: Development +build-type: Simple + +Executable hp2ps + Default-Language: Haskell2010 + Main-Is: Main.c + extra-libraries: m + C-Sources: + AreaBelow.c Curves.c Error.c Main.c + Reorder.c TopTwenty.c AuxFile.c Deviation.c + HpFile.c Marks.c Scale.c TraceElement.c + Axes.c Dimensions.c Key.c PsFile.c Shade.c + Utilities.c diff --git a/utils/hpc/HpcMarkup.hs b/utils/hpc/HpcMarkup.hs index ca30471ac4..a9b5ce1722 100644 --- a/utils/hpc/HpcMarkup.hs +++ b/utils/hpc/HpcMarkup.hs @@ -17,6 +17,7 @@ import System.FilePath import System.IO (localeEncoding) import Data.List import Data.Maybe(fromJust) +import Data.Semigroup as Semi import Data.Array import Control.Monad import qualified Data.Set as Set @@ -467,6 +468,9 @@ showSummary ticked total = percent :: (Integral a) => a -> a -> Maybe a percent ticked total = if total == 0 then Nothing else Just (ticked * 100 `div` total) +instance Semi.Semigroup ModuleSummary where + (ModuleSummary eTik1 eTot1 tTik1 tTot1 aTik1 aTot1) <> (ModuleSummary eTik2 eTot2 tTik2 tTot2 aTik2 aTot2) + = ModuleSummary (eTik1 + eTik2) (eTot1 + eTot2) (tTik1 + tTik2) (tTot1 + tTot2) (aTik1 + aTik2) (aTot1 + aTot2) instance Monoid ModuleSummary where mempty = ModuleSummary @@ -477,10 +481,7 @@ instance Monoid ModuleSummary where , altTicked = 0 , altTotal = 0 } - mappend (ModuleSummary eTik1 eTot1 tTik1 tTot1 aTik1 aTot1) - (ModuleSummary eTik2 eTot2 tTik2 tTot2 aTik2 aTot2) - = ModuleSummary (eTik1 + eTik2) (eTot1 + eTot2) (tTik1 + tTik2) (tTot1 + tTot2) (aTik1 + aTik2) (aTot1 + aTot2) - + mappend = (<>) ------------------------------------------------------------------------------ diff --git a/utils/hpc/hpc-bin.cabal b/utils/hpc/hpc-bin.cabal index e83a45d1f2..a1368cf8d0 100644 --- a/utils/hpc/hpc-bin.cabal +++ b/utils/hpc/hpc-bin.cabal @@ -31,7 +31,7 @@ Executable hpc Build-Depends: base >= 4 && < 5, directory >= 1 && < 1.4, filepath >= 1 && < 1.5, - containers >= 0.1 && < 0.6, + containers >= 0.1 && < 0.7, array >= 0.1 && < 0.6, hpc diff --git a/utils/iserv-proxy/Makefile b/utils/iserv-proxy/Makefile new file mode 100644 index 0000000000..f160978c19 --- /dev/null +++ b/utils/iserv-proxy/Makefile @@ -0,0 +1,15 @@ +# ----------------------------------------------------------------------------- +# +# (c) 2009 The University of Glasgow +# +# This file is part of the GHC build system. +# +# To understand how the build system works and how to modify it, see +# http://ghc.haskell.org/trac/ghc/wiki/Building/Architecture +# http://ghc.haskell.org/trac/ghc/wiki/Building/Modifying +# +# ----------------------------------------------------------------------------- + +dir = iserv +TOP = .. +include $(TOP)/mk/sub-makefile.mk diff --git a/utils/iserv-proxy/ghc.mk b/utils/iserv-proxy/ghc.mk new file mode 100644 index 0000000000..b90a96a1fa --- /dev/null +++ b/utils/iserv-proxy/ghc.mk @@ -0,0 +1,113 @@ +# ----------------------------------------------------------------------------- +# +# (c) 2009-2012 The University of Glasgow +# +# This file is part of the GHC build system. +# +# To understand how the build system works and how to modify it, see +# http://ghc.haskell.org/trac/ghc/wiki/Building/Architecture +# http://ghc.haskell.org/trac/ghc/wiki/Building/Modifying +# +# ----------------------------------------------------------------------------- + +utils/iserv-proxy_USES_CABAL = YES +utils/iserv-proxy_PACKAGE = iserv-proxy +utils/iserv-proxy_EXECUTABLE = iserv-proxy + +ifeq "$(GhcDebugged)" "YES" +utils/iserv-proxy_stage2_MORE_HC_OPTS += -debug +utils/iserv-proxy_stage2_p_MORE_HC_OPTS += -debug +utils/iserv-proxy_stage2_dyn_MORE_HC_OPTS += -debug +endif + +ifeq "$(GhcThreaded)" "YES" +utils/iserv-proxy_stage2_MORE_HC_OPTS += -threaded +utils/iserv-proxy_stage2_p_MORE_HC_OPTS += -threaded +utils/iserv-proxy_stage2_dyn_MORE_HC_OPTS += -threaded +endif + +# Add -Wl,--export-dynamic enables GHCi to load dynamic objects that +# refer to the RTS. This is harmless if you don't use it (adds a bit +# of overhead to startup and increases the binary sizes) but if you +# need it there's no alternative. +ifeq "$(TargetElf)" "YES" +ifneq "$(TargetOS_CPP)" "solaris2" +# The Solaris linker does not support --export-dynamic option. It also +# does not need it since it exports all dynamic symbols by default +utils/iserv-proxy_stage2_MORE_HC_OPTS += -optl-Wl,--export-dynamic +utils/iserv-proxy_stage2_p_MORE_HC_OPTS += -optl-Wl,--export-dynamic +utils/iserv-proxy_stage2_dyn_MORE_HC_OPTS += -optl-Wl,--export-dynamic +endif +endif + +# Override the default way, because we want a specific version of this +# program for each way. Note that it's important to do this even for +# the vanilla version, otherwise we get a dynamic executable when +# DYNAMIC_GHC_PROGRAMS=YES. +utils/iserv-proxy_stage2_PROGRAM_WAY = v +utils/iserv-proxy_stage2_p_PROGRAM_WAY = p +utils/iserv-proxy_stage2_dyn_PROGRAM_WAY = dyn + +utils/iserv-proxy_stage2_PROGNAME = ghc-iserv +utils/iserv-proxy_stage2_p_PROGNAME = ghc-iserv-prof +utils/iserv-proxy_stage2_dyn_PROGNAME = ghc-iserv-dyn + +utils/iserv-proxy_stage2_MORE_HC_OPTS += -no-hs-main +utils/iserv-proxy_stage2_p_MORE_HC_OPTS += -no-hs-main +utils/iserv-proxy_stage2_dyn_MORE_HC_OPTS += -no-hs-main + +utils/iserv-proxy_stage2_INSTALL = YES +utils/iserv-proxy_stage2_p_INSTALL = YES +utils/iserv-proxy_stage2_dyn_INSTALL = YES + +# Install in $(libexec), not in $(bindir) +utils/iserv-proxy_stage2_TOPDIR = YES +utils/iserv-proxy_stage2_p_TOPDIR = YES +utils/iserv-proxy_stage2_dyn_TOPDIR = YES + +utils/iserv-proxy_stage2_INSTALL_INPLACE = YES +utils/iserv-proxy_stage2_p_INSTALL_INPLACE = YES +utils/iserv-proxy_stage2_dyn_INSTALL_INPLACE = YES + +ifeq "$(CLEANING)" "YES" + +NEED_iserv = YES +NEED_iserv_p = YES +NEED_iserv_dyn = YES + +else + +ifneq "$(findstring v, $(GhcLibWays))" "" +NEED_iserv = YES +else +NEED_iserv = NO +endif + +ifneq "$(findstring p, $(GhcLibWays))" "" +NEED_iserv_p = YES +else +NEED_iserv_p = NO +endif + +ifneq "$(findstring dyn, $(GhcLibWays))" "" +NEED_iserv_dyn = YES +else +NEED_iserv_dyn = NO +endif +endif + +ifeq "$(NEED_iserv)" "YES" +$(eval $(call build-prog,utils/iserv-proxy,stage2,1)) +endif + +ifeq "$(NEED_iserv_p)" "YES" +$(eval $(call build-prog,utils/iserv-proxy,stage2_p,1)) +endif + +ifeq "$(NEED_iserv_dyn)" "YES" +$(eval $(call build-prog,utils/iserv-proxy,stage2_dyn,1)) +endif + +all_ghc_stage2 : $(iserv-proxy-stage2_INPLACE) +all_ghc_stage2 : $(iserv-proxy-stage2_p_INPLACE) +all_ghc_stage2 : $(iserv-proxy-stage2_dyn_INPLACE) diff --git a/utils/iserv-proxy/iserv-proxy.cabal b/utils/iserv-proxy/iserv-proxy.cabal new file mode 100644 index 0000000000..5d276b244d --- /dev/null +++ b/utils/iserv-proxy/iserv-proxy.cabal @@ -0,0 +1,78 @@ +Name: iserv-proxy +Version: 8.6 +Copyright: XXX +License: BSD3 +-- XXX License-File: LICENSE +Author: XXX +Maintainer: XXX +Synopsis: iserv allows GHC to delegate Tempalte Haskell computations +Description: + GHC can be provided with a path to the iserv binary with + @-pgmi=/path/to/iserv-bin@, and will in combination with + @-fexternal-interpreter@, compile Template Haskell though the + @iserv-bin@ delegate. This is very similar to how ghcjs has been + compiling Template Haskell, by spawning a separate delegate (so + called runner on the javascript vm) and evaluating the splices + there. + . + iserv can also be used in combination with cross compilation. For + this, the @iserv-proxy@ needs to be built on the host, targeting the + host (as it is running on the host). @cabal install -flibrary + -fproxy@ will yield the proxy. + . + Using the cabal for the target @arch-platform-target-cabal install + -flibrary@ will build the required library that contains the ffi + @startSlave@ function, which needs to be invoked on the target + (e.g. in an iOS application) to start the remote iserv slave. + . + calling the GHC cross compiler with @-fexternal-interpreter + -pgmi=$HOME/.cabal/bin/iserv-proxy -opti\<ip address\> -opti\<port\>@ + will cause it to compile Template Haskell via the remote at \<ip address\>. + . + Thus to get cross compilation with Template Haskell follow the + following receipt: + . + * compile the iserv library for your target + . + > iserv $ arch-platform-target-cabal install -flibrary + . + * setup an application for your target that calls the + * startSlave function. This could be either haskell or your + * targets ffi capable language, if needed. + . + > void startSlave(false /* verbose */, 5000 /* port */, + > "/path/to/storagelocation/on/target"); + . + * build the iserv-proxy + . + > iserv $ cabal install -flibrary -fproxy + * Start your iserv-slave app on your target running on say @10.0.0.1:5000@ + * compiler your sources with -fexternal-interpreter and the proxy + . + > project $ arch-platform-target-ghc ModuleContainingTH.hs \ + > -fexternal-interpreter \ + > -pgmi=$HOME/.cabal/bin/iserv-proxy \ + > -opti10.0.0.1 -opti5000 + . + Should something not work as expected, provide @-opti-v@ for verbose + logging of the @iserv-proxy@. + +Category: Development +build-type: Simple +cabal-version: >=1.10 + +Executable iserv-proxy + Default-Language: Haskell2010 + Main-Is: Main.hs + Hs-Source-Dirs: src + Build-Depends: array >= 0.5 && < 0.6, + base >= 4 && < 5, + binary >= 0.7 && < 0.9, + bytestring >= 0.10 && < 0.11, + containers >= 0.5 && < 0.6, + deepseq >= 1.4 && < 1.5, + directory >= 1.3 && < 1.4, + network >= 2.6, + filepath >= 1.4 && < 1.5, + ghci == 8.6.*, + libiserv == 8.6.* diff --git a/utils/iserv-proxy/src/Main.hs b/utils/iserv-proxy/src/Main.hs new file mode 100644 index 0000000000..c91b2d08c6 --- /dev/null +++ b/utils/iserv-proxy/src/Main.hs @@ -0,0 +1,262 @@ +{-# LANGUAGE CPP, GADTs, OverloadedStrings #-} + +{- +This is the proxy portion of iserv. + +It acts as local bridge for GHC to call +a remote slave. This all might sound +confusing, so let's try to get some +naming down. + +GHC is the actual Haskell compiler, that +acts as frontend to the code to be compiled. + +iserv is the slave, that GHC delegates compilation +of TH to. As such it needs to be compiled for +and run on the Target. In the special case +where the Host and the Target are the same, +no proxy is needed. GHC and iserv communicate +via pipes. + +iserv-proxy is the proxy instance to iserv. +The following illustration should make this +somewhat clear: + + .----- Host -----. .- Target -. + | GHC <--> proxy<+-----+> iserv | + '----------------' ^ '----------' + ^ | + | '-- communication via sockets + '--- communication via pipes + +For now, we won't support multiple concurrent +invocations of the proxy instance, and that +behavior will be undefined, as this largely +depends on the capability of the iserv on the +target to spawn multiple process. Spawning +multiple threads won't be sufficient, as the +GHC runtime has global state. + +Also the GHC runtime needs to be able to +use the linker on the Target to link archives +and object files. + +-} + +module Main (main) where + +import System.IO +import GHCi.Message +import GHCi.Utils +import GHCi.Signals + +import Remote.Message + +import Network.Socket +import Data.IORef +import Control.Monad +import System.Environment +import System.Exit +import Text.Printf +import GHC.Fingerprint (getFileHash) +import System.Directory +import System.FilePath (isAbsolute) + +import Data.Binary +import qualified Data.ByteString as BS + +dieWithUsage :: IO a +dieWithUsage = do + prog <- getProgName + die $ prog ++ ": " ++ msg + where +#if defined(WINDOWS) + msg = "usage: iserv <write-handle> <read-handle> <slave ip> [-v]" +#else + msg = "usage: iserv <write-fd> <read-fd> <slave ip> [-v]" +#endif + +main :: IO () +main = do + args <- getArgs + (wfd1, rfd2, host_ip, port, rest) <- + case args of + arg0:arg1:arg2:arg3:rest -> do + let wfd1 = read arg0 + rfd2 = read arg1 + ip = arg2 + port = read arg3 + return (wfd1, rfd2, ip, port, rest) + _ -> dieWithUsage + + verbose <- case rest of + ["-v"] -> return True + [] -> return False + _ -> dieWithUsage + + when verbose $ + printf "GHC iserv starting (in: %d; out: %d)\n" + (fromIntegral rfd2 :: Int) (fromIntegral wfd1 :: Int) + inh <- getGhcHandle rfd2 + outh <- getGhcHandle wfd1 + installSignalHandlers + lo_ref <- newIORef Nothing + let in_pipe = Pipe{pipeRead = inh, pipeWrite = outh, pipeLeftovers = lo_ref} + + when verbose $ + putStrLn ("Trying to connect to " ++ host_ip ++ ":" ++ (show port)) + out_pipe <- connectTo host_ip port >>= socketToPipe + + putStrLn "Starting proxy" + proxy verbose in_pipe out_pipe + +-- | A hook, to transform outgoing (proxy -> slave) +-- messages prior to sending them to the slave. +hook :: Msg -> IO Msg +hook = return + +-- | Forward a single @THMessage@ from the slave +-- to ghc, and read back the result from GHC. +-- +-- @Message@s go from ghc to the slave. +-- ghc --- proxy --> slave (@Message@) +-- @THMessage@s go from the slave to ghc +-- ghc <-- proxy --- slave (@THMessage@) +-- +fwdTHMsg :: (Binary a) => Pipe -> THMessage a -> IO a +fwdTHMsg local msg = do + writePipe local (putTHMessage msg) + readPipe local get + +-- | Fowarard a @Message@ call and handle @THMessages@. +fwdTHCall :: (Binary a) => Bool -> Pipe -> Pipe -> Message a -> IO a +fwdTHCall verbose local remote msg = do + writePipe remote (putMessage msg) + -- wait for control instructions + loopTH + readPipe remote get + where + loopTH :: IO () + loopTH = do + THMsg msg' <- readPipe remote getTHMessage + when verbose $ + putStrLn ("| TH Msg: ghc <- proxy -- slave: " ++ show msg') + res <- fwdTHMsg local msg' + when verbose $ + putStrLn ("| Resp.: ghc -- proxy -> slave: " ++ show res) + writePipe remote (put res) + case msg' of + RunTHDone -> return () + _ -> loopTH + +-- | Forwards a @Message@ call, and handle @SlaveMessage@. +-- Similar to @THMessages@, but @SlaveMessage@ are between +-- the slave and the proxy, and are not forwarded to ghc. +-- These message allow the Slave to query the proxy for +-- files. +-- +-- ghc --- proxy --> slave (@Message@) +-- +-- proxy <-- slave (@SlaveMessage@) +-- +fwdLoadCall :: (Binary a, Show a) => Bool -> Pipe -> Pipe -> Message a -> IO a +fwdLoadCall verbose _ remote msg = do + writePipe remote (putMessage msg) + loopLoad + readPipe remote get + where + truncateMsg :: Int -> String -> String + truncateMsg n s | length s > n = take n s ++ "..." + | otherwise = s + reply :: (Binary a, Show a) => a -> IO () + reply m = do + when verbose $ + putStrLn ("| Resp.: proxy -> slave: " + ++ truncateMsg 80 (show m)) + writePipe remote (put m) + loopLoad :: IO () + loopLoad = do + SlaveMsg msg' <- readPipe remote getSlaveMessage + when verbose $ + putStrLn ("| Sl Msg: proxy <- slave: " ++ show msg') + case msg' of + Done -> return () + Missing path -> do + reply =<< BS.readFile path + loopLoad + Have path remoteHash -> do + localHash <- getFileHash path + reply =<< if localHash == remoteHash + then return Nothing + else Just <$> BS.readFile path + loopLoad + +-- | The actual proxy. Conntect local and remote pipe, +-- and does some message handling. +proxy :: Bool -> Pipe -> Pipe -> IO () +proxy verbose local remote = loop + where + fwdCall :: (Binary a, Show a) => Message a -> IO a + fwdCall msg = do + writePipe remote (putMessage msg) + readPipe remote get + + -- reply to ghc. + reply :: (Show a, Binary a) => a -> IO () + reply msg = do + when verbose $ + putStrLn ("Resp.: ghc <- proxy -- slave: " ++ show msg) + writePipe local (put msg) + + loop = do + (Msg msg) <- readPipe local getMessage + when verbose $ + putStrLn ("Msg: ghc -- proxy -> slave: " ++ show msg) + (Msg msg') <- hook (Msg msg) + case msg' of + -- TH might send some message back to ghc. + RunTH{} -> do + resp <- fwdTHCall verbose local remote msg' + reply resp + loop + RunModFinalizers{} -> do + resp <- fwdTHCall verbose local remote msg' + reply resp + loop + -- Load messages might send some messages back to the proxy, to + -- requrest files that are not present on the device. + LoadArchive{} -> do + resp <- fwdLoadCall verbose local remote msg' + reply resp + loop + LoadObj{} -> do + resp <- fwdLoadCall verbose local remote msg' + reply resp + loop + LoadDLL path | isAbsolute path -> do + resp <- fwdLoadCall verbose local remote msg' + reply resp + loop + Shutdown{} -> fwdCall msg' >> return () + _other -> fwdCall msg' >>= reply >> loop + + +connectTo :: String -> PortNumber -> IO Socket +connectTo host port = do + let hints = defaultHints { addrFlags = [AI_NUMERICHOST, AI_NUMERICSERV] + , addrSocketType = Stream } + addr:_ <- getAddrInfo (Just hints) (Just host) (Just (show port)) + sock <- socket (addrFamily addr) (addrSocketType addr) (addrProtocol addr) + putStrLn $ "Created socket for " ++ host ++ ":" ++ show port + connect sock (addrAddress addr) + putStrLn "connected" + return sock + +-- | Turn a socket into an unbuffered pipe. +socketToPipe :: Socket -> IO Pipe +socketToPipe sock = do + hdl <- socketToHandle sock ReadWriteMode + hSetBuffering hdl NoBuffering + + lo_ref <- newIORef Nothing + pure Pipe{ pipeRead = hdl, pipeWrite = hdl, pipeLeftovers = lo_ref } diff --git a/utils/iserv/Makefile b/utils/iserv/Makefile new file mode 100644 index 0000000000..361985852f --- /dev/null +++ b/utils/iserv/Makefile @@ -0,0 +1,15 @@ +# ----------------------------------------------------------------------------- +# +# (c) 2009 The University of Glasgow +# +# This file is part of the GHC build system. +# +# To understand how the build system works and how to modify it, see +# http://ghc.haskell.org/trac/ghc/wiki/Building/Architecture +# http://ghc.haskell.org/trac/ghc/wiki/Building/Modifying +# +# ----------------------------------------------------------------------------- + +dir = utils/iserv +TOP = ../.. +include $(TOP)/mk/sub-makefile.mk diff --git a/utils/iserv/cbits/iservmain.c b/utils/iserv/cbits/iservmain.c new file mode 100644 index 0000000000..daefd35251 --- /dev/null +++ b/utils/iserv/cbits/iservmain.c @@ -0,0 +1,17 @@ +#include "../rts/PosixSource.h" +#include "Rts.h" + +#include "HsFFI.h" + +int main (int argc, char *argv[]) +{ + RtsConfig conf = defaultRtsConfig; + + // We never know what symbols GHC will look up in the future, so + // we must retain CAFs for running interpreted code. + conf.keep_cafs = 1; + + conf.rts_opts_enabled = RtsOptsAll; + extern StgClosure ZCMain_main_closure; + hs_main(argc, argv, &ZCMain_main_closure, conf); +} diff --git a/utils/iserv/ghc.mk b/utils/iserv/ghc.mk new file mode 100644 index 0000000000..194621a85c --- /dev/null +++ b/utils/iserv/ghc.mk @@ -0,0 +1,113 @@ +# ----------------------------------------------------------------------------- +# +# (c) 2009-2012 The University of Glasgow +# +# This file is part of the GHC build system. +# +# To understand how the build system works and how to modify it, see +# http://ghc.haskell.org/trac/ghc/wiki/Building/Architecture +# http://ghc.haskell.org/trac/ghc/wiki/Building/Modifying +# +# ----------------------------------------------------------------------------- + +utils/iserv_USES_CABAL = YES +utils/iserv_PACKAGE = iserv +utils/iserv_EXECUTABLE = iserv + +ifeq "$(GhcDebugged)" "YES" +utils/iserv_stage2_MORE_HC_OPTS += -debug +utils/iserv_stage2_p_MORE_HC_OPTS += -debug +utils/iserv_stage2_dyn_MORE_HC_OPTS += -debug +endif + +ifeq "$(GhcThreaded)" "YES" +utils/iserv_stage2_MORE_HC_OPTS += -threaded +utils/iserv_stage2_p_MORE_HC_OPTS += -threaded +utils/iserv_stage2_dyn_MORE_HC_OPTS += -threaded +endif + +# Add -Wl,--export-dynamic enables GHCi to load dynamic objects that +# refer to the RTS. This is harmless if you don't use it (adds a bit +# of overhead to startup and increases the binary sizes) but if you +# need it there's no alternative. +ifeq "$(TargetElf)" "YES" +ifneq "$(TargetOS_CPP)" "solaris2" +# The Solaris linker does not support --export-dynamic option. It also +# does not need it since it exports all dynamic symbols by default +utils/iserv_stage2_MORE_HC_OPTS += -optl-Wl,--export-dynamic +utils/iserv_stage2_p_MORE_HC_OPTS += -optl-Wl,--export-dynamic +utils/iserv_stage2_dyn_MORE_HC_OPTS += -optl-Wl,--export-dynamic +endif +endif + +# Override the default way, because we want a specific version of this +# program for each way. Note that it's important to do this even for +# the vanilla version, otherwise we get a dynamic executable when +# DYNAMIC_GHC_PROGRAMS=YES. +utils/iserv_stage2_PROGRAM_WAY = v +utils/iserv_stage2_p_PROGRAM_WAY = p +utils/iserv_stage2_dyn_PROGRAM_WAY = dyn + +utils/iserv_stage2_PROGNAME = ghc-iserv +utils/iserv_stage2_p_PROGNAME = ghc-iserv-prof +utils/iserv_stage2_dyn_PROGNAME = ghc-iserv-dyn + +utils/iserv_stage2_MORE_HC_OPTS += -no-hs-main +utils/iserv_stage2_p_MORE_HC_OPTS += -no-hs-main +utils/iserv_stage2_dyn_MORE_HC_OPTS += -no-hs-main + +utils/iserv_stage2_INSTALL = YES +utils/iserv_stage2_p_INSTALL = YES +utils/iserv_stage2_dyn_INSTALL = YES + +# Install in $(libexec), not in $(bindir) +utils/iserv_stage2_TOPDIR = YES +utils/iserv_stage2_p_TOPDIR = YES +utils/iserv_stage2_dyn_TOPDIR = YES + +utils/iserv_stage2_INSTALL_INPLACE = YES +utils/iserv_stage2_p_INSTALL_INPLACE = YES +utils/iserv_stage2_dyn_INSTALL_INPLACE = YES + +ifeq "$(CLEANING)" "YES" + +NEED_iserv = YES +NEED_iserv_p = YES +NEED_iserv_dyn = YES + +else + +ifneq "$(findstring v, $(GhcLibWays))" "" +NEED_iserv = YES +else +NEED_iserv = NO +endif + +ifneq "$(findstring p, $(GhcLibWays))" "" +NEED_iserv_p = YES +else +NEED_iserv_p = NO +endif + +ifneq "$(findstring dyn, $(GhcLibWays))" "" +NEED_iserv_dyn = YES +else +NEED_iserv_dyn = NO +endif +endif + +ifeq "$(NEED_iserv)" "YES" +$(eval $(call build-prog,utils/iserv,stage2,1)) +endif + +ifeq "$(NEED_iserv_p)" "YES" +$(eval $(call build-prog,utils/iserv,stage2_p,1)) +endif + +ifeq "$(NEED_iserv_dyn)" "YES" +$(eval $(call build-prog,utils/iserv,stage2_dyn,1)) +endif + +all_ghc_stage2 : $(iserv-stage2_INPLACE) +all_ghc_stage2 : $(iserv-stage2_p_INPLACE) +all_ghc_stage2 : $(iserv-stage2_dyn_INPLACE) diff --git a/utils/iserv/iserv.cabal b/utils/iserv/iserv.cabal new file mode 100644 index 0000000000..0f45c8d3c3 --- /dev/null +++ b/utils/iserv/iserv.cabal @@ -0,0 +1,44 @@ +Name: iserv +Version: 8.7.1 +Copyright: XXX +License: BSD3 +-- XXX License-File: LICENSE +Author: XXX +Maintainer: XXX +Synopsis: iserv allows GHC to delegate Tempalte Haskell computations +Description: + GHC can be provided with a path to the iserv binary with + @-pgmi=/path/to/iserv-bin@, and will in combination with + @-fexternal-interpreter@, compile Template Haskell though the + @iserv-bin@ delegate. This is very similar to how ghcjs has been + compiling Template Haskell, by spawning a separate delegate (so + called runner on the javascript vm) and evaluating the splices + there. + . + To use iserv with cross compilers, please see @libraries/libiserv@ + and @utils/iserv-proxy@. + +Category: Development +build-type: Simple +cabal-version: >=1.10 + +Executable iserv + Default-Language: Haskell2010 + ghc-options: -no-hs-main + Main-Is: Main.hs + C-Sources: cbits/iservmain.c + Hs-Source-Dirs: src + include-dirs: . + Build-Depends: array >= 0.5 && < 0.6, + base >= 4 && < 5, + binary >= 0.7 && < 0.11, + bytestring >= 0.10 && < 0.11, + containers >= 0.5 && < 0.7, + deepseq >= 1.4 && < 1.5, + ghci == 8.7.*, + libiserv == 8.7.* + + if os(windows) + Cpp-Options: -DWINDOWS + else + Build-Depends: unix >= 2.7 && < 2.9 diff --git a/utils/iserv/src/Main.hs b/utils/iserv/src/Main.hs new file mode 100644 index 0000000000..858cee8e94 --- /dev/null +++ b/utils/iserv/src/Main.hs @@ -0,0 +1,63 @@ +{-# LANGUAGE CPP, GADTs #-} + +-- | +-- The Remote GHCi server. +-- +-- For details on Remote GHCi, see Note [Remote GHCi] in +-- compiler/ghci/GHCi.hs. +-- +module Main (main) where + +import Lib (serv) + +import GHCi.Message +import GHCi.Signals +import GHCi.Utils + +import Control.Exception +import Control.Monad +import Data.IORef +import System.Environment +import System.Exit +import Text.Printf + +dieWithUsage :: IO a +dieWithUsage = do + prog <- getProgName + die $ prog ++ ": " ++ msg + where +#ifdef WINDOWS + msg = "usage: iserv <write-handle> <read-handle> [-v]" +#else + msg = "usage: iserv <write-fd> <read-fd> [-v]" +#endif + +main :: IO () +main = do + args <- getArgs + (wfd1, rfd2, rest) <- + case args of + arg0:arg1:rest -> do + let wfd1 = read arg0 + rfd2 = read arg1 + return (wfd1, rfd2, rest) + _ -> dieWithUsage + + verbose <- case rest of + ["-v"] -> return True + [] -> return False + _ -> dieWithUsage + when verbose $ + printf "GHC iserv starting (in: %d; out: %d)\n" + (fromIntegral rfd2 :: Int) (fromIntegral wfd1 :: Int) + inh <- getGhcHandle rfd2 + outh <- getGhcHandle wfd1 + installSignalHandlers + lo_ref <- newIORef Nothing + let pipe = Pipe{pipeRead = inh, pipeWrite = outh, pipeLeftovers = lo_ref} + uninterruptibleMask $ serv verbose hook pipe + + where hook = return -- empty hook + -- we cannot allow any async exceptions while communicating, because + -- we will lose sync in the protocol, hence uninterruptibleMask. + diff --git a/utils/llvm-targets/gen-data-layout.sh b/utils/llvm-targets/gen-data-layout.sh new file mode 100755 index 0000000000..85ee5c52c4 --- /dev/null +++ b/utils/llvm-targets/gen-data-layout.sh @@ -0,0 +1,112 @@ +#!/usr/bin/env bash +# +# llvm-target generator +# +# Author: Moritz Angermann <moritz.angermann@gmail.com> +# +# This file generates the `llvm-targets` file, which contains the +# data-layout, cpu and attributes for the target. This is done by +# querying `clang` for the data-layout, cpu and attributes based +# on a given target. +# +# To utilize it run it as +# +# $ ./gen-data-layout.sh > llvm-targets +# +# Add missing targets to the list below to have them included in +# llvm-targets file. + +# Target sets for which to generate the llvm-targets file +TARGETS=( + # Windows x86 + "i386-unknown-windows" "i686-unknown-windows" "x86_64-unknown-windows" + + # Linux ARM + "arm-unknown-linux-gnueabihf" "armv6-unknown-linux-gnueabihf" "armv6l-unknown-linux-gnueabihf" + "armv7-unknown-linux-gnueabihf" "armv7a-unknown-linux-gnueabi" "armv7l-unknown-linux-gnueabihf" + "aarch64-unknown-linux-gnu" "aarch64-unknown-linux" + # Linux x86 + "i386-unknown-linux-gnu" "i386-unknown-linux" "x86_64-unknown-linux-gnu" "x86_64-unknown-linux" + # Linux Android + "armv7-unknown-linux-androideabi" "aarch64-unknown-linux-android" + # Linux ppc64le + "powerpc64le-unknown-linux" + + # FreeBSD amd64 + "amd64-portbld-freebsd" + + # QNX + "arm-unknown-nto-qnx-eabi" + + # macOS + "i386-apple-darwin" "x86_64-apple-darwin" + # iOS + "armv7-apple-ios arm64-apple-ios" "i386-apple-ios x86_64-apple-ios" + + # FreeBSD ARM + "aarch64-unknown-freebsd" "armv6-unknown-freebsd-gnueabihf" "armv7-unknown-freebsd-gnueabihf" +) + +# given the call to clang -c11 that clang --target -v generates, +# parse the -target-cpu <CPU> and -target-feature <feature> from +# the output. +function get_cpu_and_attr() { + # echo $@ + while [ "$#" -gt 0 ]; do + case "$1" in + -target-cpu) CPU=$2; shift 2;; + -target-feature) + # translate clang to opt/llc target features + case "$2" in + # we don't have support in GHC for proper soft-float. + # if we extend the `llvm-target` file to contain two + # additional columns for opt and llc flags, we could + # pass -float-abi=soft; However ghc will use float + # registers unconditionally on arm, and as such true + # soft float with the registerised llvm backend is + # currently not possible. + +soft-float-abi) shift 2;; + *) ATTR+=("$2"); shift 2;; + esac + ;; + *) shift 1;; + esac + done +} + +# first marker to discriminate the first line being outputted. +FST=1 +# a dummy file to use for the clang invocation. +FILE=_____dummy.c +touch $FILE + +for target in "${TARGETS[@]}"; do + # find the cpu and attributes emitted by clang for the given $target + CPU="" + ATTR=() + args=$(clang --target=$target -S $FILE -o /dev/null -v 2>&1 |grep $FILE) + get_cpu_and_attr $args + + # find the data-layout from the llvm code emitted by clang. + dl=$(clang --target=$target -S $FILE -emit-llvm -o -|grep datalayout |awk -F\ '{ print $4 }') + # GNU and Apple/LLVM can't agree on the aarch64 target. + # aarch64-apple-ios, is understood by autotools but not by LLVM. + # arm64-apple-ios, is understood by LLVM, but not by autotools. + # + # therefore, while we query clang with arm64-apple-ios, we put + # aarch64-apple-ios into the llvm-target list, as that is what + # we have to configure ghc with --target with anyway. Also we + # want to retain the GNU naming for compatibility with libraries + # that use autotools. + if [ "$target" == "arm64-apple-ios" ]; then + target="aarch64-apple-ios" + fi + if [ $FST -eq 1 ]; then + echo "[(\"${target}\", ($dl, \"$CPU\", \"${ATTR[*]}\"))" + FST=0 + else + echo ",(\"${target}\", ($dl, \"$CPU\", \"${ATTR[*]}\"))" + fi +done +rm $FILE +echo "]" diff --git a/utils/lndir/lndir.c b/utils/lndir/lndir.c index 87f2824166..8ea5ab2ab4 100644 --- a/utils/lndir/lndir.c +++ b/utils/lndir/lndir.c @@ -2,7 +2,7 @@ /* Create shadow link tree (after X11R4 script of the same name) Mark Reinhold (mbr@lcs.mit.edu)/3 January 1990 */ -/* +/* Copyright (c) 1990, X Consortium Permission is hereby granted, free of charge, to any person obtaining a copy @@ -46,6 +46,7 @@ in this Software without prior written authorization from the X Consortium. #define NeedVarargsPrototypes 1 #include "lndir-Xos.h" +#include "fs.h" #include <stdlib.h> #include <stdio.h> #include <sys/stat.h> @@ -182,11 +183,11 @@ int copyfile(const char *oldpath, const char *newpath) { return symlink(oldpath, newpath); } else { #endif - f_old = fopen(oldpath, "rb"); + f_old = __hs_fopen(oldpath, "rb"); if (f_old == NULL) { return -1; } - f_new = fopen(newpath, "wbx"); + f_new = __hs_fopen(newpath, "wbx"); if (f_new == NULL) { e = errno; fclose(f_old); @@ -272,7 +273,7 @@ int rel; /* if true, prepend "../" to fn before using */ else buf[0] = '\0'; strcat (buf, fn); - + if (!(df = opendir (buf))) { msg ("%s: Cannot opendir", buf); return 1; @@ -305,7 +306,7 @@ int rel; /* if true, prepend "../" to fn before using */ #if defined(S_ISDIR) if(S_ISDIR(sb.st_mode)) #else - if (sb.st_mode & S_IFDIR) + if (sb.st_mode & S_IFDIR) #endif { /* directory */ @@ -397,7 +398,7 @@ int rel; /* if true, prepend "../" to fn before using */ mperror (dp->d_name); } } - + closedir (df); return 0; } @@ -410,7 +411,7 @@ char **av; char* tn; struct stat fs, ts; #if defined(__CYGWIN32__) - /* + /* The lndir code assumes unix-style paths to work. cygwin lets you get away with using dos'ish paths (e.g., "f:/oo") in most contexts. Using them with 'lndir' will seriously @@ -457,7 +458,7 @@ char **av; if (stat (tn, &ts) < 0) { if (force && (tn[0] != '.' || tn[1] != '\0') ) { mymkdir(tn, S_IRWXU | S_IRWXG | S_IROTH | S_IXOTH ); - } + } else { quiterr (1, tn); #if defined(S_ISDIR) diff --git a/utils/mkUserGuidePart/DList.hs b/utils/mkUserGuidePart/DList.hs deleted file mode 100644 index c4b9283e52..0000000000 --- a/utils/mkUserGuidePart/DList.hs +++ /dev/null @@ -1,13 +0,0 @@ -module DList where - -newtype DList a = DList ([a] -> [a]) - -snoc :: DList a -> a -> DList a -DList f `snoc` x = DList (f . (x:)) - -toList :: DList a -> [a] -toList (DList f) = f [] - -instance Monoid (DList a) where - mempty = DList id - DList a `mappend` DList b = DList (a . b) diff --git a/utils/mkUserGuidePart/Main.hs b/utils/mkUserGuidePart/Main.hs deleted file mode 100644 index 99f921c8f4..0000000000 --- a/utils/mkUserGuidePart/Main.hs +++ /dev/null @@ -1,110 +0,0 @@ -module Main (main) where - -import DynFlags -import Control.Monad (forM_) -import Types hiding (flag) -import Table -import Options - -import System.IO - -writeFileUtf8 :: FilePath -> String -> IO () -writeFileUtf8 f txt = withFile f WriteMode (\ hdl -> hSetEncoding hdl utf8 >> hPutStr hdl txt) - --- | A ReStructuredText fragment -type ReST = String - -main :: IO () -main = do - -- user's guide - writeRestFile (usersGuideFile "what_glasgow_exts_does.gen.rst") - $ whatGlasgowExtsDoes - forM_ groups $ \(Group name _ theFlags) -> - let fname = usersGuideFile $ "flags-"++name++".gen.rst" - in writeRestFile fname (flagsTable theFlags) - - -- man page - writeRestFile (usersGuideFile "all-flags.gen.rst") (flagsList groups) - -usersGuideFile :: FilePath -> FilePath -usersGuideFile fname = "docs/users_guide/"++fname - -writeRestFile :: FilePath -> ReST -> IO () -writeRestFile fname content = - writeFileUtf8 fname $ unlines - [ ".. This file is generated by utils/mkUserGuidePart" - , "" - , content - ] - -whatGlasgowExtsDoes :: String -whatGlasgowExtsDoes = unlines - $ [ ".. hlist::", ""] - ++ map ((" * "++) . parseExt) glasgowExtsFlags - where - parseExt ext = inlineCode $ "-X" ++ show ext - --- | Generate a reference table of the given set of flags. This is used in --- the user's guide. -flagsTable :: [Flag] -> ReST -flagsTable theFlags = - table [60, 100, 30, 55] - ["Flag", "Description", "Type", "Reverse"] - (map flagRow theFlags) - where - flagRow flag = - [ role "ghc-flag" (flagName flag) - , flagDescription flag - , type_ - , role "ghc-flag" (flagReverse flag) - ] - where - type_ = case flagType flag of - DynamicFlag -> "dynamic" - DynamicSettableFlag -> "dynamic/``:set``" - ModeFlag -> "mode" - --- | Place the given text in an ReST inline code element. -inlineCode :: String -> ReST -inlineCode s = "``" ++ s ++ "``" - --- | @role "hi" "Hello world"@ produces the ReST inline role element --- @:hi:`Hello world`@. -role :: String -> String -> ReST -role _ "" = "" -role r c = concat [":",r,":`",flag,"`",next] - where - -- Handle multiple comma separated flags - (flag, rest) = span (/= ',') c - next | rest == "" = rest - | otherwise = concat [", ", role r $ dropWhile (/= '-') rest] - -heading :: Char -> String -> ReST -heading chr title = unlines - [ title - , replicate (length title) chr - , "" - ] - --- | Generate a listing of all the flags known to GHC. --- Used in the man page. -flagsList :: [Group] -> ReST -flagsList grps = unlines $ - map doGroup grps ++ map flagDescriptions grps - where - doGroup grp = unlines - [ grpTitle grp - , " " ++ unwords (map (inlineCode . flagName) (grpFlags grp)) - , "" - ] - --- | Generate a definition list of the known flags. --- Used in the man page. -flagDescriptions :: Group -> ReST -flagDescriptions (Group _ title fs) = - unlines $ [ heading '~' title ] ++ map doFlag fs - where - doFlag flag = - unlines $ [ inlineCode (flagName flag) - , " " ++ flagDescription flag - ] diff --git a/utils/mkUserGuidePart/Options.hs b/utils/mkUserGuidePart/Options.hs deleted file mode 100644 index ab1ab696fe..0000000000 --- a/utils/mkUserGuidePart/Options.hs +++ /dev/null @@ -1,66 +0,0 @@ -module Options (Group(..), groups) where - -import Types - -import Options.CodeGen -import Options.CompilerDebugging -import Options.Cpp -import Options.FindingImports -import Options.Interactive -import Options.InterfaceFiles -import Options.KeepingIntermediates -import Options.Language -import Options.Linking -import Options.Misc -import Options.Modes -import Options.Optimizations -import Options.OptimizationLevels -import Options.Packages -import Options.Phases -import Options.PhasePrograms -import Options.PhaseSpecific -import Options.PlatformSpecific -import Options.Plugin -import Options.Profiling -import Options.ProgramCoverage -import Options.RecompilationChecking -import Options.RedirectingOutput -import Options.TemporaryFiles -import Options.Verbosity -import Options.Warnings - --- | A group of flags -data Group = Group { grpName :: String -- ^ Internal name - , grpTitle :: String -- ^ Human-readable title - , grpFlags :: [Flag] -- ^ Flags in group - } - -groups :: [Group] -groups = - [ Group "codegen" "Code generation" codegenOptions - , Group "compiler-debugging" "Debugging the compiler" compilerDebuggingOptions - , Group "cpp" "C pre-processor" cppOptions - , Group "finding-imports" "Finding imports" findingImportsOptions - , Group "interactive" "Interactive mode" interactiveOptions - , Group "interface-files" "Interface files" interfaceFilesOptions - , Group "keeping-intermediates" "Keeping intermediate files" keepingIntermediatesOptions - , Group "language" "Language options" languageOptions - , Group "linking" "Linking options" linkingOptions - , Group "misc" "Miscellaneous options" miscOptions - , Group "modes" "Modes of operation" modeOptions - , Group "optimization" "Individual optimizations " optimizationsOptions - , Group "optimization-levels" "Optimization levels" optimizationLevelsOptions - , Group "packages" "Package options" packagesOptions - , Group "phases" "Phases of compilation" phaseOptions - , Group "phase-programs" "Overriding external programs" phaseProgramsOptions - , Group "phase-specific" "Phase-specific options" phaseSpecificOptions - , Group "platform-specific" "Platform-specific options" platformSpecificOptions - , Group "plugin" "Compiler plugins" pluginOptions - , Group "profiling" "Profiling" profilingOptions - , Group "program-coverage" "Program coverage" programCoverageOptions - , Group "recompilation-checking" "Recompilation checking" recompilationCheckingOptions - , Group "redirecting-output" "Redirecting output" redirectingOutputOptions - , Group "temporary-files" "Temporary files" temporaryFilesOptions - , Group "verbosity" "Verbosity options" verbosityOptions - , Group "warnings" "Warnings" warningsOptions - ] diff --git a/utils/mkUserGuidePart/Options/CodeGen.hs b/utils/mkUserGuidePart/Options/CodeGen.hs deleted file mode 100644 index 0a5d6c1976..0000000000 --- a/utils/mkUserGuidePart/Options/CodeGen.hs +++ /dev/null @@ -1,52 +0,0 @@ -module Options.CodeGen where - -import Types - -codegenOptions :: [Flag] -codegenOptions = - [ flag { flagName = "-fasm" - , flagDescription = - "Use the :ref:`native code generator <native-code-gen>`" - , flagType = DynamicFlag - , flagReverse = "-fllvm" - } - , flag { flagName = "-fllvm" - , flagDescription = - "Compile using the :ref:`LLVM code generator <llvm-code-gen>`" - , flagType = DynamicFlag - , flagReverse = "-fasm" - } - , flag { flagName = "-fno-code" - , flagDescription = "Omit code generation" - , flagType = DynamicFlag - } - , flag { flagName = "-fwrite-interface" - , flagDescription = "Always write interface files" - , flagType = DynamicFlag - } - , flag { flagName = "-fbyte-code" - , flagDescription = "Generate byte-code" - , flagType = DynamicFlag - } - , flag { flagName = "-fobject-code" - , flagDescription = "Generate object code" - , flagType = DynamicFlag - } - , flag { flagName = "-g⟨n⟩" - , flagDescription = - "Produce DWARF debug information in compiled object files." ++ - "⟨n⟩ can be 0, 1, or 2, with higher numbers producing richer " ++ - "output. If ⟨n⟩ is omitted level 2 is assumed." - , flagType = DynamicFlag - } - , flag { flagName = "-dynamic" - , flagDescription = "Build dynamically-linked object files and executables" - , flagType = DynamicFlag - } - , flag { flagName = "-dynamic-too" - , flagDescription = - "Build dynamic object files *as well as* static object files " ++ - "during compilation" - , flagType = DynamicFlag - } - ] diff --git a/utils/mkUserGuidePart/Options/CompilerDebugging.hs b/utils/mkUserGuidePart/Options/CompilerDebugging.hs deleted file mode 100644 index 1d643a1385..0000000000 --- a/utils/mkUserGuidePart/Options/CompilerDebugging.hs +++ /dev/null @@ -1,287 +0,0 @@ -module Options.CompilerDebugging where - -import Types - -compilerDebuggingOptions :: [Flag] -compilerDebuggingOptions = - [ flag { flagName = "-dcore-lint" - , flagDescription = "Turn on internal sanity checking" - , flagType = DynamicFlag - } - , flag { flagName = "-ddump-to-file" - , flagDescription = "Dump to files instead of stdout" - , flagType = DynamicFlag - } - , flag { flagName = "-ddump-asm" - , flagDescription = "Dump assembly" - , flagType = DynamicFlag - } - , flag { flagName = "-ddump-bcos" - , flagDescription = "Dump interpreter byte code" - , flagType = DynamicFlag - } - , flag { flagName = "-ddump-cmm-from-stg" - , flagDescription = "Dump STG-to-C-- output" - , flagType = DynamicFlag - } - , flag { flagName = "-ddump-cmm-verbose" - , flagDescription = "Show output from each C-- pipeline pass" - , flagType = DynamicFlag - } - , flag { flagName = "-ddump-cmm" - , flagDescription = "Dump the final C-- output" - , flagType = DynamicFlag - } - , flag { flagName = "-ddump-core-stats" - , flagDescription = - "Print a one-line summary of the size of the Core program at the "++ - "end of the optimisation pipeline" - , flagType = DynamicFlag - } - , flag { flagName = "-ddump-cse" - , flagDescription = "Dump CSE output" - , flagType = DynamicFlag - } - , flag { flagName = "-ddump-deriv" - , flagDescription = "Dump deriving output" - , flagType = DynamicFlag - } - , flag { flagName = "-ddump-ds" - , flagDescription = "Dump desugarer output" - , flagType = DynamicFlag - } - , flag { flagName = "-ddump-foreign" - , flagDescription = "Dump ``foreign export`` stubs" - , flagType = DynamicFlag - } - , flag { flagName = "-ddump-hpc" - , flagDescription = "Dump after instrumentation for program coverage" - , flagType = DynamicFlag - } - , flag { flagName = "-ddump-inlinings" - , flagDescription = "Dump inlining info" - , flagType = DynamicFlag - } - , flag { flagName = "-ddump-llvm" - , flagDescription = "Dump LLVM intermediate code. "++ - "Implies :ghc-flag:`-fllvm`." - , flagType = DynamicFlag - } - , flag { flagName = "-ddump-occur-anal" - , flagDescription = "Dump occurrence analysis output" - , flagType = DynamicFlag - } - , flag { flagName = "-ddump-opt-cmm" - , flagDescription = "Dump the results of C-- to C-- optimising passes" - , flagType = DynamicFlag - } - , flag { flagName = "-ddump-parsed" - , flagDescription = "Dump parse tree" - , flagType = DynamicFlag - } - , flag { flagName = "-ddump-prep" - , flagDescription = "Dump prepared core" - , flagType = DynamicFlag - } - , flag { flagName = "-ddump-rn" - , flagDescription = "Dump renamer output" - , flagType = DynamicFlag - } - , flag { flagName = "-ddump-rule-firings" - , flagDescription = "Dump rule firing info" - , flagType = DynamicFlag - } - , flag { flagName = "-ddump-rule-rewrites" - , flagDescription = "Dump detailed rule firing info" - , flagType = DynamicFlag - } - , flag { flagName = "-ddump-rules" - , flagDescription = "Dump rules" - , flagType = DynamicFlag - } - , flag { flagName = "-ddump-vect" - , flagDescription = "Dump vectoriser input and output" - , flagType = DynamicFlag - } - , flag { flagName = "-ddump-simpl" - , flagDescription = "Dump final simplifier output" - , flagType = DynamicFlag - } - , flag { flagName = "-ddump-simpl-iterations" - , flagDescription = "Dump output from each simplifier iteration" - , flagType = DynamicFlag - } - , flag { flagName = "-ddump-spec" - , flagDescription = "Dump specialiser output" - , flagType = DynamicFlag - } - , flag { flagName = "-ddump-splices" - , flagDescription = - "Dump TH spliced expressions, and what they evaluate to" - , flagType = DynamicFlag - } - , flag { flagName = "-ddump-stg" - , flagDescription = "Dump final STG" - , flagType = DynamicFlag - } - , flag { flagName = "-ddump-stranal" - , flagDescription = "Dump strictness analyser output" - , flagType = DynamicFlag - } - , flag { flagName = "-ddump-str-signatures" - , flagDescription = "Dump strictness signatures" - , flagType = DynamicFlag - } - , flag { flagName = "-ddump-tc" - , flagDescription = "Dump typechecker output" - , flagType = DynamicFlag - } - , flag { flagName = "-dth-dec-file=⟨file⟩" - , flagDescription = - "Show evaluated TH declarations in a .th.hs file" - , flagType = DynamicFlag - } - , flag { flagName = "-ddump-types" - , flagDescription = "Dump type signatures" - , flagType = DynamicFlag - } - , flag { flagName = "-ddump-worker-wrapper" - , flagDescription = "Dump worker-wrapper output" - , flagType = DynamicFlag - } - , flag { flagName = "-ddump-if-trace" - , flagDescription = "Trace interface files" - , flagType = DynamicFlag - } - , flag { flagName = "-ddump-tc-trace" - , flagDescription = "Trace typechecker" - , flagType = DynamicFlag - } - , flag { flagName = "-ddump-vt-trace" - , flagDescription = "Trace vectoriser" - , flagType = DynamicFlag - } - , flag { flagName = "-ddump-rn-trace" - , flagDescription = "Trace renamer" - , flagType = DynamicFlag - } - , flag { flagName = "-ddump-rn-stats" - , flagDescription = "Renamer stats" - , flagType = DynamicFlag - } - , flag { flagName = "-ddump-simpl-stats" - , flagDescription = "Dump simplifier stats" - , flagType = DynamicFlag - } - , flag { flagName = "-dno-debug-output" - , flagDescription = "Suppress unsolicited debugging output" - , flagType = DynamicFlag - } - , flag { flagName = "-dppr-debug" - , flagDescription = "Turn on debug printing (more verbose)" - , flagType = DynamicFlag - } - , flag { flagName = "-dppr-user-length" - , flagDescription = - "Set the depth for printing expressions in error msgs" - , flagType = DynamicFlag - } - , flag { flagName = "-dppr-cols=⟨n⟩" - , flagDescription = - "Set the width of debugging output. For example ``-dppr-cols200``" - , flagType = DynamicFlag - } - , flag { flagName = "-dppr-case-as-let" - , flagDescription = - "Print single alternative case expressions as strict lets." - , flagType = DynamicFlag - } - , flag { flagName = "-dsuppress-all" - , flagDescription = - "In core dumps, suppress everything (except for uniques) that is "++ - "suppressible." - , flagType = DynamicFlag - } - , flag { flagName = "-dsuppress-uniques" - , flagDescription = - "Suppress the printing of uniques in debug output (easier to use "++ - "``diff``)" - , flagType = DynamicFlag - } - , flag { flagName = "-dsuppress-idinfo" - , flagDescription = - "Suppress extended information about identifiers where they "++ - "are bound" - , flagType = DynamicFlag - } - , flag { flagName = "-dsuppress-unfoldings" - , flagDescription = - "Suppress the printing of the stable unfolding of a variable at "++ - "its binding site" - , flagType = DynamicFlag - } - , flag { flagName = "-dsuppress-module-prefixes" - , flagDescription = - "Suppress the printing of module qualification prefixes" - , flagType = DynamicFlag - } - , flag { flagName = "-dsuppress-type-signatures" - , flagDescription = "Suppress type signatures" - , flagType = DynamicFlag - } - , flag { flagName = "-dsuppress-type-applications" - , flagDescription = "Suppress type applications" - , flagType = DynamicFlag - } - , flag { flagName = "-dsuppress-coercions" - , flagDescription = - "Suppress the printing of coercions in Core dumps to make them "++ - "shorter" - , flagType = DynamicFlag - } - , flag { flagName = "-dsource-stats" - , flagDescription = "Dump haskell source stats" - , flagType = DynamicFlag - } - , flag { flagName = "-dcmm-lint" - , flagDescription = "C-- pass sanity checking" - , flagType = DynamicFlag - } - , flag { flagName = "-dstg-lint" - , flagDescription = "STG pass sanity checking" - , flagType = DynamicFlag - } - , flag { flagName = "-dstg-stats" - , flagDescription = "Dump STG stats" - , flagType = DynamicFlag - } - , flag { flagName = "-dverbose-core2core" - , flagDescription = "Show output from each core-to-core pass" - , flagType = DynamicFlag - } - , flag { flagName = "-dverbose-stg2stg" - , flagDescription = "Show output from each STG-to-STG pass" - , flagType = DynamicFlag - } - , flag { flagName = "-dshow-passes" - , flagDescription = "Print out each pass name as it happens" - , flagType = DynamicFlag - } - , flag { flagName = "-dfaststring-stats" - , flagDescription = - "Show statistics for fast string usage when finished" - , flagType = DynamicFlag - } - , flag { flagName = "-frule-check" - , flagDescription = - "Report sites with rules that could have fired but didn't. "++ - "Takes a string argument." - , flagType = DynamicFlag - } - , flag { flagName = "-fcatch-bottoms" - , flagDescription = - "Insert ``error`` expressions after bottoming expressions; useful "++ - "when debugging the compiler." - , flagType = DynamicFlag - } - ] diff --git a/utils/mkUserGuidePart/Options/Cpp.hs b/utils/mkUserGuidePart/Options/Cpp.hs deleted file mode 100644 index ae5b122bf9..0000000000 --- a/utils/mkUserGuidePart/Options/Cpp.hs +++ /dev/null @@ -1,25 +0,0 @@ -module Options.Cpp where - -import Types - -cppOptions :: [Flag] -cppOptions = - [ flag { flagName = "-cpp" - , flagDescription = "Run the C pre-processor on Haskell source files" - , flagType = DynamicFlag - } - , flag { flagName = "-D⟨symbol⟩[=⟨value⟩]" - , flagDescription = "Define a symbol in the C pre-processor" - , flagType = DynamicFlag - , flagReverse = "-U⟨symbol⟩" - } - , flag { flagName = "-U⟨symbol⟩" - , flagDescription = "Undefine a symbol in the C pre-processor" - , flagType = DynamicFlag - } - , flag { flagName = "-I⟨dir⟩" - , flagDescription = - "Add ⟨dir⟩ to the directory search list for ``#include`` files" - , flagType = DynamicFlag - } - ] diff --git a/utils/mkUserGuidePart/Options/FindingImports.hs b/utils/mkUserGuidePart/Options/FindingImports.hs deleted file mode 100644 index 65f5ebacba..0000000000 --- a/utils/mkUserGuidePart/Options/FindingImports.hs +++ /dev/null @@ -1,15 +0,0 @@ -module Options.FindingImports where - -import Types - -findingImportsOptions :: [Flag] -findingImportsOptions = - [ flag { flagName = "-i⟨dir⟩[:⟨dir⟩]*" - , flagDescription = "add ⟨dir⟩, ⟨dir2⟩, etc. to import path" - , flagType = DynamicSettableFlag - } - , flag { flagName = "-i" - , flagDescription = "Empty the import directory list" - , flagType = DynamicSettableFlag - } - ] diff --git a/utils/mkUserGuidePart/Options/Interactive.hs b/utils/mkUserGuidePart/Options/Interactive.hs deleted file mode 100644 index 0137fc8c86..0000000000 --- a/utils/mkUserGuidePart/Options/Interactive.hs +++ /dev/null @@ -1,65 +0,0 @@ -module Options.Interactive where - -import Types - -interactiveOptions :: [Flag] -interactiveOptions = - [ flag { flagName = "-ignore-dot-ghci" - , flagDescription = "Disable reading of ``.ghci`` files" - , flagType = DynamicFlag - } - , flag { flagName = "-ghci-script" - , flagDescription = "Read additional ``.ghci`` files" - , flagType = DynamicFlag - } - , flag { flagName = "-fbreak-on-error" - , flagDescription = - ":ref:`Break on uncaught exceptions and errors " ++ - "<ghci-debugger-exceptions>`" - , flagType = DynamicFlag - , flagReverse = "-fno-break-on-error" - } - , flag { flagName = "-fbreak-on-exception" - , flagDescription = - ":ref:`Break on any exception thrown <ghci-debugger-exceptions>`" - , flagType = DynamicFlag - , flagReverse = "-fno-break-on-exception" - } - , flag { flagName = "-fghci-hist-size=⟨n⟩" - , flagDescription = - "Set the number of entries GHCi keeps for ``:history``." ++ - " See :ref:`ghci-debugger`." - , flagType = DynamicFlag - , flagReverse = "" - } - , flag { flagName = "-fprint-evld-with-show" - , flagDescription = - "Enable usage of ``Show`` instances in ``:print``. "++ - "See :ref:`breakpoints`." - , flagType = DynamicFlag - , flagReverse = "-fno-print-evld-with-show" - } - , flag { flagName = "-fprint-bind-result" - , flagDescription = - ":ref:`Turn on printing of binding results in GHCi <ghci-stmts>`" - , flagType = DynamicFlag - , flagReverse = "-fno-print-bind-result" - } - , flag { flagName = "-fno-print-bind-contents" - , flagDescription = - ":ref:`Turn off printing of binding contents in GHCi <breakpoints>`" - , flagType = DynamicFlag - } - , flag { flagName = "-fno-implicit-import-qualified" - , flagDescription = - ":ref:`Turn off implicit qualified import of everything in GHCi " ++ - "<ghci-import-qualified>`" - , flagType = DynamicFlag - } - , flag { flagName = "-interactive-print ⟨expr⟩" - , flagDescription = - ":ref:`Select the function to use for printing evaluated " ++ - "expressions in GHCi <ghci-interactive-print>`" - , flagType = DynamicFlag - } - ] diff --git a/utils/mkUserGuidePart/Options/InterfaceFiles.hs b/utils/mkUserGuidePart/Options/InterfaceFiles.hs deleted file mode 100644 index 314e0ebb69..0000000000 --- a/utils/mkUserGuidePart/Options/InterfaceFiles.hs +++ /dev/null @@ -1,23 +0,0 @@ -module Options.InterfaceFiles where - -import Types - -interfaceFilesOptions :: [Flag] -interfaceFilesOptions = - [ flag { flagName = "-ddump-hi" - , flagDescription = "Dump the new interface to stdout" - , flagType = DynamicFlag - } - , flag { flagName = "-ddump-hi-diffs" - , flagDescription = "Show the differences vs. the old interface" - , flagType = DynamicFlag - } - , flag { flagName = "-ddump-minimal-imports" - , flagDescription = "Dump a minimal set of imports" - , flagType = DynamicFlag - } - , flag { flagName = "--show-iface ⟨file⟩" - , flagDescription = "See :ref:`modes`." - , flagType = ModeFlag - } - ] diff --git a/utils/mkUserGuidePart/Options/KeepingIntermediates.hs b/utils/mkUserGuidePart/Options/KeepingIntermediates.hs deleted file mode 100644 index eb264092a4..0000000000 --- a/utils/mkUserGuidePart/Options/KeepingIntermediates.hs +++ /dev/null @@ -1,36 +0,0 @@ -module Options.KeepingIntermediates where - -import Types - -keepingIntermediatesOptions :: [Flag] -keepingIntermediatesOptions = - [ flag { flagName = "-keep-hc-file, -keep-hc-files" - , flagDescription = "Retain intermediate ``.hc`` files." - , flagType = DynamicFlag - } - , flag { flagName = "-keep-hi-files" - , flagDescription = - "Retain intermediate ``.hi`` files (the default)." - , flagType = DynamicFlag - , flagReverse = "-no-keep-hi-files" - } - , flag { flagName = "-keep-llvm-file, -keep-llvm-files" - , flagDescription = "Retain intermediate LLVM ``.ll`` files. "++ - "Implies :ghc-flag:`-fllvm`." - , flagType = DynamicFlag - } - , flag { flagName = "-keep-o-files" - , flagDescription = - "Retain intermediate ``.o`` files (the default)." - , flagType = DynamicFlag - , flagReverse = "-no-keep-o-files" - } - , flag { flagName = "-keep-s-file, -keep-s-files" - , flagDescription = "Retain intermediate ``.s`` files." - , flagType = DynamicFlag - } - , flag { flagName = "-keep-tmp-files" - , flagDescription = "Retain all intermediate temporary files." - , flagType = DynamicFlag - } - ] diff --git a/utils/mkUserGuidePart/Options/Language.hs b/utils/mkUserGuidePart/Options/Language.hs deleted file mode 100644 index e584d2f38b..0000000000 --- a/utils/mkUserGuidePart/Options/Language.hs +++ /dev/null @@ -1,775 +0,0 @@ -module Options.Language where - -import Types - -languageOptions :: [Flag] -languageOptions = - [ flag { flagName = "-fconstraint-solver-iterations=⟨n⟩" - , flagDescription = - "*default: 4.* Set the iteration limit for the type-constraint "++ - "solver. Typically one iteration suffices; so please "++ - "yell if you find you need to set it higher than the default. "++ - "Zero means infinity." - , flagType = DynamicFlag - } - , flag { flagName = "-freduction-depth=⟨n⟩" - , flagDescription = - "*default: 200.* Set the :ref:`limit for type simplification "++ - "<undecidable-instances>`. Zero means infinity." - , flagType = DynamicFlag - } - , flag { flagName = "-fcontext-stack=⟨n⟩" - , flagDescription = - "Deprecated. Use ``-freduction-depth=⟨n⟩`` instead." - , flagType = DynamicFlag - } - , flag { flagName = "-fglasgow-exts" - , flagDescription = - "Deprecated. Enable most language extensions; "++ - "see :ref:`options-language` for exactly which ones." - , flagType = DynamicFlag - , flagReverse = "-fno-glasgow-exts" - } - , flag { flagName = "-firrefutable-tuples" - , flagDescription = "Make tuple pattern matching irrefutable" - , flagType = DynamicFlag - , flagReverse = "-fno-irrefutable-tuples" - } - , flag { flagName = "-fpackage-trust" - , flagDescription = - "Enable :ref:`Safe Haskell <safe-haskell>` trusted package "++ - "requirement for trustworthy modules." - , flagType = DynamicFlag - } - , flag { flagName = "-ftype-function-depth=⟨n⟩" - , flagDescription = "Deprecated. Use ``-freduction-depth=⟨n⟩`` instead." - , flagType = DynamicFlag - } - , flag { flagName = "-XAllowAmbiguousTypes" - , flagDescription = - "Allow the user to write :ref:`ambiguous types <ambiguity>`, and "++ - "the type inference engine to infer them." - , flagType = DynamicFlag - , flagReverse = "-XNoAllowAmbiguousTypes" - , flagSince = "7.8.1" - } - , flag { flagName = "-XArrows" - , flagDescription = - "Enable :ref:`arrow notation <arrow-notation>` extension" - , flagType = DynamicFlag - , flagReverse = "-XNoArrows" - , flagSince = "6.8.1" - } - , flag { flagName = "-XApplicativeDo" - , flagDescription = - "Enable :ref:`Applicative do-notation desugaring <applicative-do>`" - , flagType = DynamicFlag - , flagReverse = "-XNoApplicativeDo" - , flagSince = "8.0.1" - } - , flag { flagName = "-XAutoDeriveTypeable" - , flagDescription = - "As of GHC 7.10, this option is not needed, and should not be "++ - "used. Previously this would automatically :ref:`derive Typeable "++ - "instances for every datatype and type class declaration "++ - "<deriving-typeable>`. Implies :ghc-flag:`-XDeriveDataTypeable`." - , flagType = DynamicFlag - , flagReverse = "-XNoAutoDeriveTypeable" - , flagSince = "7.8.1" - } - , flag { flagName = "-XBangPatterns" - , flagDescription = "Enable :ref:`bang patterns <bang-patterns>`." - , flagType = DynamicFlag - , flagReverse = "-XNoBangPatterns" - , flagSince = "6.8.1" - } - , flag { flagName = "-XBinaryLiterals" - , flagDescription = - "Enable support for :ref:`binary literals <binary-literals>`." - , flagType = DynamicFlag - , flagReverse = "-XNoBinaryLiterals" - , flagSince = "7.10.1" - } - , flag { flagName = "-XCApiFFI" - , flagDescription = - "Enable :ref:`the CAPI calling convention <ffi-capi>`." - , flagType = DynamicFlag - , flagReverse = "-XNoCAPIFFI" - , flagSince = "7.10.1" - } - , flag { flagName = "-XConstrainedClassMethods" - , flagDescription = - "Enable :ref:`constrained class methods <class-method-types>`." - , flagType = DynamicFlag - , flagReverse = "-XNoConstrainedClassMethods" - , flagSince = "6.8.1" - } - , flag { flagName = "-XConstraintKinds" - , flagDescription = - "Enable a :ref:`kind of constraints <constraint-kind>`." - , flagType = DynamicFlag - , flagReverse = "-XNoConstraintKinds" - , flagSince = "7.4.1" - } - , flag { flagName = "-XCPP" - , flagDescription = - "Enable the :ref:`C preprocessor <c-pre-processor>`." - , flagType = DynamicFlag - , flagReverse = "-XNoCPP" - , flagSince = "6.8.1" - } - , flag { flagName = "-XDataKinds" - , flagDescription = "Enable :ref:`datatype promotion <promotion>`." - , flagType = DynamicFlag - , flagReverse = "-XNoDataKinds" - , flagSince = "7.4.1" - } - , flag { flagName = "-XDefaultSignatures" - , flagDescription = - "Enable :ref:`default signatures <class-default-signatures>`." - , flagType = DynamicFlag - , flagReverse = "-XNoDefaultSignatures" - , flagSince = "7.2.1" - } - , flag { flagName = "-XDeriveAnyClass" - , flagDescription = - "Enable :ref:`deriving for any class <derive-any-class>`." - , flagType = DynamicFlag - , flagReverse = "-XNoDeriveAnyClass" - , flagSince = "7.10.1" - } - , flag { flagName = "-XDeriveDataTypeable" - , flagDescription = - "Enable ``deriving`` for the :ref:`Data class "++ - "<deriving-typeable>`. Implied by :ghc-flag:`-XAutoDeriveTypeable`." - , flagType = DynamicFlag - , flagReverse = "-XNoDeriveDataTypeable" - , flagSince = "6.8.1" - } - , flag { flagName = "-XDeriveFunctor" - , flagDescription = - "Enable :ref:`deriving for the Functor class <deriving-extra>`. "++ - "Implied by :ghc-flag:`-XDeriveTraversable`." - , flagType = DynamicFlag - , flagReverse = "-XNoDeriveFunctor" - , flagSince = "7.10.1" - } - , flag { flagName = "-XDeriveFoldable" - , flagDescription = - "Enable :ref:`deriving for the Foldable class <deriving-extra>`. "++ - "Implied by :ghc-flag:`-XDeriveTraversable`." - , flagType = DynamicFlag - , flagReverse = "-XNoDeriveFoldable" - , flagSince = "7.10.1" - } - , flag { flagName = "-XDeriveGeneric" - , flagDescription = - "Enable :ref:`deriving for the Generic class <deriving-typeable>`." - , flagType = DynamicFlag - , flagReverse = "-XNoDeriveGeneric" - , flagSince = "7.2.1" - } - , flag { flagName = "-XDeriveLift" - , flagDescription = - "Enable :ref:`deriving for the Lift class <deriving-lift>`" - , flagType = DynamicFlag - , flagReverse = "-XNoDeriveLift" - , flagSince = "7.2.1" - } - , flag { flagName = "-XDeriveTraversable" - , flagDescription = - "Enable :ref:`deriving for the Traversable class <deriving-extra>`. "++ - "Implies :ghc-flag:`-XDeriveFunctor` and :ghc-flag:`-XDeriveFoldable`." - , flagType = DynamicFlag - , flagReverse = "-XNoDeriveTraversable" - , flagSince = "7.10.1" - } - , flag { flagName = "-XDerivingStrategies" - , flagDescription = - "Enables :ref:`deriving strategies <deriving-strategies>`." - , flagType = DynamicFlag - , flagReverse = "-XNoDerivingStrategies" - , flagSince = "8.2.1" - } - , flag { flagName = "-XDisambiguateRecordFields" - , flagDescription = - "Enable :ref:`record field disambiguation <disambiguate-fields>`. "++ - "Implied by :ghc-flag:`-XRecordWildCards`." - , flagType = DynamicFlag - , flagReverse = "-XNoDisambiguateRecordFields" - , flagSince = "6.8.1" - } - , flag { flagName = "-XEmptyCase" - , flagDescription = - "Allow :ref:`empty case alternatives <empty-case>`." - , flagType = DynamicFlag - , flagReverse = "-XNoEmptyCase" - , flagSince = "7.8.1" - } - , flag { flagName = "-XEmptyDataDecls" - , flagDescription = "Enable empty data declarations." - , flagType = DynamicFlag - , flagReverse = "-XNoEmptyDataDecls" - , flagSince = "6.8.1" - } - , flag { flagName = "-XExistentialQuantification" - , flagDescription = - "Enable :ref:`existential quantification <existential-quantification>`." - , flagType = DynamicFlag - , flagReverse = "-XNoExistentialQuantification" - , flagSince = "6.8.1" - } - , flag { flagName = "-XExplicitForAll" - , flagDescription = - "Enable :ref:`explicit universal quantification <explicit-foralls>`."++ - " Implied by :ghc-flag:`-XScopedTypeVariables`, :ghc-flag:`-XLiberalTypeSynonyms`,"++ - " :ghc-flag:`-XRankNTypes` and :ghc-flag:`-XExistentialQuantification`." - , flagType = DynamicFlag - , flagReverse = "-XNoExplicitForAll" - , flagSince = "6.12.1" - } - , flag { flagName = "-XExplicitNamespaces" - , flagDescription = - "Enable using the keyword ``type`` to specify the namespace of "++ - "entries in imports and exports (:ref:`explicit-namespaces`). "++ - "Implied by :ghc-flag:`-XTypeOperators` and :ghc-flag:`-XTypeFamilies`." - , flagType = DynamicFlag - , flagReverse = "-XNoExplicitNamespaces" - , flagSince = "7.6.1" - } - , flag { flagName = "-XExtendedDefaultRules" - , flagDescription = - "Use GHCi's :ref:`extended default rules <extended-default-rules>` "++ - "in a normal module." - , flagType = DynamicFlag - , flagReverse = "-XNoExtendedDefaultRules" - , flagSince = "6.8.1" - } - , flag { flagName = "-XFlexibleContexts" - , flagDescription = - "Enable :ref:`flexible contexts <flexible-contexts>`. Implied by "++ - ":ghc-flag:`-XImplicitParams`." - , flagType = DynamicFlag - , flagReverse = "-XNoFlexibleContexts" - , flagSince = "6.8.1" - } - , flag { flagName = "-XFlexibleInstances" - , flagDescription = - "Enable :ref:`flexible instances <instance-rules>`. "++ - "Implies :ghc-flag:`-XTypeSynonymInstances`. "++ - "Implied by :ghc-flag:`-XImplicitParams`." - , flagType = DynamicFlag - , flagReverse = "-XNoFlexibleInstances" - , flagSince = "6.8.1" - } - , flag { flagName = "-XForeignFunctionInterface" - , flagDescription = - "Enable :ref:`foreign function interface <ffi>`." - , flagType = DynamicFlag - , flagReverse = "-XNoForeignFunctionInterface" - , flagSince = "6.8.1" - } - , flag { flagName = "-XFunctionalDependencies" - , flagDescription = - "Enable :ref:`functional dependencies <functional-dependencies>`. "++ - "Implies :ghc-flag:`-XMultiParamTypeClasses`." - , flagType = DynamicFlag - , flagReverse = "-XNoFunctionalDependencies" - , flagSince = "6.8.1" - } - , flag { flagName = "-XGADTs" - , flagDescription = - "Enable :ref:`generalised algebraic data types <gadt>`. "++ - "Implies :ghc-flag:`-XGADTSyntax` and :ghc-flag:`-XMonoLocalBinds`." - , flagType = DynamicFlag - , flagReverse = "-XNoGADTs" - , flagSince = "6.8.1" - } - , flag { flagName = "-XGADTSyntax" - , flagDescription = - "Enable :ref:`generalised algebraic data type syntax <gadt-style>`." - , flagType = DynamicFlag - , flagReverse = "-XNoGADTSyntax" - , flagSince = "7.2.1" - } - , flag { flagName = "-XGeneralizedNewtypeDeriving" - , flagDescription = - "Enable :ref:`newtype deriving <newtype-deriving>`." - , flagType = DynamicFlag - , flagReverse = "-XNoGeneralizedNewtypeDeriving" - , flagSince = "6.8.1" - } - , flag { flagName = "-XGenerics" - , flagDescription = - "Deprecated, does nothing. No longer enables "++ - ":ref:`generic classes <generic-classes>`. See also GHC's support "++ - "for :ref:`generic programming <generic-programming>`." - , flagType = DynamicFlag - , flagReverse = "-XNoGenerics" - , flagSince = "6.8.1" - } - , flag { flagName = "-XImplicitParams" - , flagDescription = - "Enable :ref:`Implicit Parameters <implicit-parameters>`. "++ - "Implies :ghc-flag:`-XFlexibleContexts` and :ghc-flag:`-XFlexibleInstances`." - , flagType = DynamicFlag - , flagReverse = "-XNoImplicitParams" - , flagSince = "6.8.1" - } - , flag { flagName = "-XNoImplicitPrelude" - , flagDescription = - "Don't implicitly ``import Prelude``. "++ - "Implied by :ghc-flag:`-XRebindableSyntax`." - , flagType = DynamicFlag - , flagReverse = "-XImplicitPrelude" - , flagSince = "6.8.1" - } - , flag { flagName = "-XImpredicativeTypes" - , flagDescription = - "Enable :ref:`impredicative types <impredicative-polymorphism>`. "++ - "Implies :ghc-flag:`-XRankNTypes`." - , flagType = DynamicFlag - , flagReverse = "-XNoImpredicativeTypes" - , flagSince = "6.10.1" - } - , flag { flagName = "-XIncoherentInstances" - , flagDescription = - "Enable :ref:`incoherent instances <instance-overlap>`. "++ - "Implies :ghc-flag:`-XOverlappingInstances`." - , flagType = DynamicFlag - , flagReverse = "-XNoIncoherentInstances" - , flagSince = "6.8.1" - } - , flag { flagName = "-XTypeFamilyDependencies" - , flagDescription = - "Enable :ref:`injective type families <injective-ty-fams>`. "++ - "Implies :ghc-flag:`-XTypeFamilies`." - , flagType = DynamicFlag - , flagReverse = "-XNoTypeFamilyDependencies" - , flagSince = "8.0.1" - } - , flag { flagName = "-XInstanceSigs" - , flagDescription = - "Enable :ref:`instance signatures <instance-sigs>`." - , flagType = DynamicFlag - , flagReverse = "-XNoInstanceSigs" - , flagSince = "7.10.1" - } - , flag { flagName = "-XInterruptibleFFI" - , flagDescription = "Enable interruptible FFI." - , flagType = DynamicFlag - , flagReverse = "-XNoInterruptibleFFI" - , flagSince = "7.2.1" - } - , flag { flagName = "-XKindSignatures" - , flagDescription = - "Enable :ref:`kind signatures <kinding>`. "++ - "Implied by :ghc-flag:`-XTypeFamilies` and :ghc-flag:`-XPolyKinds`." - , flagType = DynamicFlag - , flagReverse = "-XNoKindSignatures" - , flagSince = "6.8.1" - } - , flag { flagName = "-XLambdaCase" - , flagDescription = - "Enable :ref:`lambda-case expressions <lambda-case>`." - , flagType = DynamicFlag - , flagReverse = "-XNoLambdaCase" - , flagSince = "7.6.1" - } - , flag { flagName = "-XLiberalTypeSynonyms" - , flagDescription = - "Enable :ref:`liberalised type synonyms <type-synonyms>`." - , flagType = DynamicFlag - , flagReverse = "-XNoLiberalTypeSynonyms" - , flagSince = "6.8.1" - } - , flag { flagName = "-XMagicHash" - , flagDescription = - "Allow ``#`` as a :ref:`postfix modifier on identifiers <magic-hash>`." - , flagType = DynamicFlag - , flagReverse = "-XNoMagicHash" - , flagSince = "6.8.1" - } - , flag { flagName = "-XMonadComprehensions" - , flagDescription = - "Enable :ref:`monad comprehensions <monad-comprehensions>`." - , flagType = DynamicFlag - , flagReverse = "-XNoMonadComprehensions" - , flagSince = "7.2.1" - } - , flag { flagName = "-XMonoLocalBinds" - , flagDescription = - "Enable :ref:`do not generalise local bindings <mono-local-binds>`. "++ - "Implied by :ghc-flag:`-XTypeFamilies` and :ghc-flag:`-XGADTs`." - , flagType = DynamicFlag - , flagReverse = "-XNoMonoLocalBinds" - , flagSince = "6.12.1" - } - , flag { flagName = "-XNoMonomorphismRestriction" - , flagDescription = - "Disable the :ref:`monomorphism restriction <monomorphism>`." - , flagType = DynamicFlag - , flagReverse = "-XMonomorphismRestriction" - , flagSince = "6.8.1" - } - , flag { flagName = "-XMultiParamTypeClasses" - , flagDescription = - "Enable :ref:`multi parameter type classes "++ - "<multi-param-type-classes>`. Implied by "++ - ":ghc-flag:`-XFunctionalDependencies`." - , flagType = DynamicFlag - , flagReverse = "-XNoMultiParamTypeClasses" - , flagSince = "6.8.1" - } - , flag { flagName = "-XMultiWayIf" - , flagDescription = - "Enable :ref:`multi-way if-expressions <multi-way-if>`." - , flagType = DynamicFlag - , flagReverse = "-XNoMultiWayIf" - , flagSince = "7.6.1" - } - , flag { flagName = "-XNamedFieldPuns" - , flagDescription = "Enable :ref:`record puns <record-puns>`." - , flagType = DynamicFlag - , flagReverse = "-XNoNamedFieldPuns" - , flagSince = "6.10.1" - } - , flag { flagName = "-XNamedWildCards" - , flagDescription = "Enable :ref:`named wildcards <named-wildcards>`." - , flagType = DynamicFlag - , flagReverse = "-XNoNamedWildCards" - , flagSince = "7.10.1" - } - , flag { flagName = "-XNegativeLiterals" - , flagDescription = - "Enable support for :ref:`negative literals <negative-literals>`." - , flagType = DynamicFlag - , flagReverse = "-XNoNegativeLiterals" - , flagSince = "7.8.1" - } - , flag { flagName = "-XNPlusKPatterns" - , flagDescription = "Enable support for ``n+k`` patterns. "++ - "Implied by :ghc-flag:`-XHaskell98`." - , flagType = DynamicFlag - , flagReverse = "-XNoNPlusKPatterns" - , flagSince = "6.12.1" - } - , flag { flagName = "-XNullaryTypeClasses" - , flagDescription = - "Deprecated, does nothing. :ref:`nullary (no parameter) type "++ - "classes <nullary-type-classes>` are now enabled using "++ - ":ghc-flag:`-XMultiParamTypeClasses`." - , flagType = DynamicFlag - , flagReverse = "-XNoNullaryTypeClasses" - , flagSince = "7.8.1" - } - , flag { flagName = "-XNumDecimals" - , flagDescription = - "Enable support for 'fractional' integer literals." - , flagType = DynamicFlag - , flagReverse = "-XNoNumDecimals" - , flagSince = "7.8.1" - } - , flag { flagName = "-XOverlappingInstances" - , flagDescription = - "Enable :ref:`overlapping instances <instance-overlap>`." - , flagType = DynamicFlag - , flagReverse = "-XNoOverlappingInstances" - , flagSince = "6.8.1" - } - , flag { flagName = "-XOverloadedLabels" - , flagDescription = - "Enable :ref:`overloaded labels <overloaded-labels>`." - , flagType = DynamicFlag - , flagReverse = "-XNoOverloadedLabels" - , flagSince = "8.0.1" - } - , flag { flagName = "-XOverloadedLists" - , flagDescription = - "Enable :ref:`overloaded lists <overloaded-lists>`." - , flagType = DynamicFlag - , flagReverse = "-XNoOverloadedLists" - , flagSince = "7.8.1" - } - , flag { flagName = "-XOverloadedStrings" - , flagDescription = - "Enable :ref:`overloaded string literals <overloaded-strings>`." - , flagType = DynamicFlag - , flagReverse = "-XNoOverloadedStrings" - , flagSince = "6.8.1" - } - , flag { flagName = "-XPackageImports" - , flagDescription = - "Enable :ref:`package-qualified imports <package-imports>`." - , flagType = DynamicFlag - , flagReverse = "-XNoPackageImports" - , flagSince = "6.10.1" - } - , flag { flagName = "-XParallelArrays" - , flagDescription = - "Enable parallel arrays. Implies :ghc-flag:`-XParallelListComp`." - , flagType = DynamicFlag - , flagReverse = "-XNoParallelArrays" - , flagSince = "7.4.1" - } - , flag { flagName = "-XParallelListComp" - , flagDescription = - "Enable :ref:`parallel list comprehensions "++ - "<parallel-list-comprehensions>`. "++ - "Implied by :ghc-flag:`-XParallelArrays`." - , flagType = DynamicFlag - , flagReverse = "-XNoParallelListComp" - , flagSince = "6.8.1" - } - , flag { flagName = "-XPartialTypeSignatures" - , flagDescription = - "Enable :ref:`partial type signatures <partial-type-signatures>`." - , flagType = DynamicFlag - , flagReverse = "-XNoPartialTypeSignatures" - , flagSince = "7.10.1" - } - , flag { flagName = "-XNoPatternGuards" - , flagDescription = "Disable :ref:`pattern guards <pattern-guards>`. "++ - "Implied by :ghc-flag:`-XHaskell98`." - , flagType = DynamicFlag - , flagReverse = "-XPatternGuards" - , flagSince = "6.8.1" - } - , flag { flagName = "-XPatternSynonyms" - , flagDescription = - "Enable :ref:`pattern synonyms <pattern-synonyms>`." - , flagType = DynamicFlag - , flagReverse = "-XNoPatternSynonyms" - , flagSince = "7.10.1" - } - , flag { flagName = "-XPolyKinds" - , flagDescription = - "Enable :ref:`kind polymorphism <kind-polymorphism>`. "++ - "Implies :ghc-flag:`-XKindSignatures`." - , flagType = DynamicFlag - , flagReverse = "-XNoPolyKinds" - , flagSince = "7.4.1" - } - , flag { flagName = "-XPolymorphicComponents" - , flagDescription = - "Enable :ref:`polymorphic components for data constructors "++ - "<universal-quantification>`. Synonym for :ghc-flag:`-XRankNTypes`." - , flagType = DynamicFlag - , flagReverse = "-XNoPolymorphicComponents" - , flagSince = "6.8.1" - } - , flag { flagName = "-XPostfixOperators" - , flagDescription = - "Enable :ref:`postfix operators <postfix-operators>`." - , flagType = DynamicFlag - , flagReverse = "-XNoPostfixOperators" - , flagSince = "7.10.1" - } - , flag { flagName = "-XQuasiQuotes" - , flagDescription = "Enable :ref:`quasiquotation <th-quasiquotation>`." - , flagType = DynamicFlag - , flagReverse = "-XNoQuasiQuotes" - , flagSince = "6.10.1" - } - , flag { flagName = "-XRank2Types" - , flagDescription = - "Enable :ref:`rank-2 types <universal-quantification>`. "++ - "Synonym for :ghc-flag:`-XRankNTypes`." - , flagType = DynamicFlag - , flagReverse = "-XNoRank2Types" - , flagSince = "6.8.1" - } - , flag { flagName = "-XRankNTypes" - , flagDescription = - "Enable :ref:`rank-N types <universal-quantification>`. "++ - "Implied by :ghc-flag:`-XImpredicativeTypes`." - , flagType = DynamicFlag - , flagReverse = "-XNoRankNTypes" - , flagSince = "6.8.1" - } - , flag { flagName = "-XRebindableSyntax" - , flagDescription = - "Employ :ref:`rebindable syntax <rebindable-syntax>`. "++ - "Implies :ghc-flag:`-XNoImplicitPrelude`." - , flagType = DynamicFlag - , flagReverse = "-XNoRebindableSyntax" - , flagSince = "7.0.1" - } - , flag { flagName = "-XRecordWildCards" - , flagDescription = - "Enable :ref:`record wildcards <record-wildcards>`. "++ - "Implies :ghc-flag:`-XDisambiguateRecordFields`." - , flagType = DynamicFlag - , flagReverse = "-XNoRecordWildCards" - , flagSince = "6.8.1" - } - , flag { flagName = "-XRecursiveDo" - , flagDescription = - "Enable :ref:`recursive do (mdo) notation <recursive-do-notation>`." - , flagType = DynamicFlag - , flagReverse = "-XNoRecursiveDo" - , flagSince = "6.8.1" - } - , flag { flagName = "-XRoleAnnotations" - , flagDescription = - "Enable :ref:`role annotations <role-annotations>`." - , flagType = DynamicFlag - , flagReverse = "-XNoRoleAnnotations" - , flagSince = "7.10.1" - } - , flag { flagName = "-XSafe" - , flagDescription = - "Enable the :ref:`Safe Haskell <safe-haskell>` Safe mode." - , flagType = DynamicFlag - , flagSince = "7.2.1" - } - , flag { flagName = "-XScopedTypeVariables" - , flagDescription = - "Enable :ref:`lexically-scoped type variables "++ - "<scoped-type-variables>`." - , flagType = DynamicFlag - , flagReverse = "-XNoScopedTypeVariables" - , flagSince = "6.8.1" - } - , flag { flagName = "-XStandaloneDeriving" - , flagDescription = - "Enable :ref:`standalone deriving <stand-alone-deriving>`." - , flagType = DynamicFlag - , flagReverse = "-XNoStandaloneDeriving" - , flagSince = "6.8.1" - } - , flag { flagName = "-XStaticPointers" - , flagDescription = - "Enable :ref:`static pointers <static-pointers>`." - , flagType = DynamicFlag - , flagReverse = "-XNoStaticPointers" - , flagSince = "7.10.1" - } - , flag { flagName = "-XStrictData" - , flagDescription = - "Enable :ref:`default strict datatype fields <strict-data>`." - , flagType = DynamicFlag - , flagReverse = "-XNoStrictData" - } - , flag { flagName = "-XTemplateHaskell" - , flagDescription = - "Enable :ref:`Template Haskell <template-haskell>`." - , flagType = DynamicFlag - , flagReverse = "-XNoTemplateHaskell" - , flagSince = "6.8.1" - } - , flag { flagName = "-XTemplateHaskellQuotes" - , flagDescription = "Enable quotation subset of "++ - ":ref:`Template Haskell <template-haskell>`." - , flagType = DynamicFlag - , flagReverse = "-XNoTemplateHaskellQuotes" - , flagSince = "8.0.1" - } - , flag { flagName = "-XNoTraditionalRecordSyntax" - , flagDescription = - "Disable support for traditional record syntax "++ - "(as supported by Haskell 98) ``C {f = x}``" - , flagType = DynamicFlag - , flagReverse = "-XTraditionalRecordSyntax" - , flagSince = "7.4.1" - } - , flag { flagName = "-XTransformListComp" - , flagDescription = - "Enable :ref:`generalised list comprehensions "++ - "<generalised-list-comprehensions>`." - , flagType = DynamicFlag - , flagReverse = "-XNoTransformListComp" - , flagSince = "6.10.1" - } - , flag { flagName = "-XTrustworthy" - , flagDescription = - "Enable the :ref:`Safe Haskell <safe-haskell>` Trustworthy mode." - , flagType = DynamicFlag - , flagSince = "7.2.1" - } - , flag { flagName = "-XTupleSections" - , flagDescription = "Enable :ref:`tuple sections <tuple-sections>`." - , flagType = DynamicFlag - , flagReverse = "-XNoTupleSections" - , flagSince = "7.10.1" - } - , flag { flagName = "-XTypeFamilies" - , flagDescription = - "Enable :ref:`type families <type-families>`. "++ - "Implies :ghc-flag:`-XExplicitNamespaces`, :ghc-flag:`-XKindSignatures`, "++ - "and :ghc-flag:`-XMonoLocalBinds`." - , flagType = DynamicFlag - , flagReverse = "-XNoTypeFamilies" - , flagSince = "6.8.1" - } - , flag { flagName = "-XTypeInType" - , flagDescription = - "Allow :ref:`kinds to be used as types <type-in-type>`, " ++ - "including explicit kind variable quantification, higher-rank "++ - "kinds, kind synonyms, and kind families. "++ - "Implies :ghc-flag:`-XDataKinds`, :ghc-flag:`-XKindSignatures`, " ++ - "and :ghc-flag:`-XPolyKinds`." - , flagType = DynamicFlag - , flagReverse = "-XNoTypeInType" - , flagSince = "8.0.1" - } - , flag { flagName = "-XTypeOperators" - , flagDescription = - "Enable :ref:`type operators <type-operators>`. "++ - "Implies :ghc-flag:`-XExplicitNamespaces`." - , flagType = DynamicFlag - , flagReverse = "-XNoTypeOperators" - , flagSince = "6.8.1" - } - , flag { flagName = "-XTypeSynonymInstances" - , flagDescription = - "Enable :ref:`type synonyms in instance heads "++ - "<flexible-instance-head>`. Implied by :ghc-flag:`-XFlexibleInstances`." - , flagType = DynamicFlag - , flagReverse = "-XNoTypeSynonymInstances" - , flagSince = "6.8.1" - } - , flag { flagName = "-XUnboxedTuples" - , flagDescription = "Enable :ref:`unboxed tuples <unboxed-tuples>`." - , flagType = DynamicFlag - , flagReverse = "-XNoUnboxedTuples" - , flagSince = "6.8.1" - } - , flag { flagName ="-XUnboxedSums" - , flagDescription = "Enable :ref: `unboxed sums <unboxed-sums>`." - , flagType = DynamicFlag - , flagReverse = "-XNoUnboxedSums" - , flagSince = "8.2.1" - } - , flag { flagName = "-XUndecidableInstances" - , flagDescription = - "Enable :ref:`undecidable instances <undecidable-instances>`." - , flagType = DynamicFlag - , flagReverse = "-XNoUndecidableInstances" - , flagSince = "6.8.1" - } - , flag { flagName = "-XUnicodeSyntax" - , flagDescription = "Enable :ref:`unicode syntax <unicode-syntax>`." - , flagType = DynamicFlag - , flagReverse = "-XNoUnicodeSyntax" - , flagSince = "6.8.1" - } - , flag { flagName = "-XUnliftedFFITypes" - , flagDescription = "Enable unlifted FFI types." - , flagType = DynamicFlag - , flagReverse = "-XNoUnliftedFFITypes" - , flagSince = "6.8.1" - } - , flag { flagName = "-XUnsafe" - , flagDescription = - "Enable :ref:`Safe Haskell <safe-haskell>` Unsafe mode." - , flagType = DynamicFlag - , flagSince = "7.4.1" - } - , flag { flagName = "-XViewPatterns" - , flagDescription = "Enable :ref:`view patterns <view-patterns>`." - , flagType = DynamicFlag - , flagReverse = "-XNoViewPatterns" - , flagSince = "6.10.1" - } - ] diff --git a/utils/mkUserGuidePart/Options/Linking.hs b/utils/mkUserGuidePart/Options/Linking.hs deleted file mode 100644 index 20d6f1feb2..0000000000 --- a/utils/mkUserGuidePart/Options/Linking.hs +++ /dev/null @@ -1,149 +0,0 @@ -module Options.Linking where - -import Types - -linkingOptions :: [Flag] -linkingOptions = - [ flag { flagName = "-shared" - , flagDescription = - "Generate a shared library (as opposed to an executable)" - , flagType = DynamicFlag - } - , flag { flagName = "-staticlib" - , flagDescription = - "Generate a standalone static library (as opposed to an " ++ - "executable). This is useful when cross compiling. The " ++ - "library together with all its dependencies ends up in in a " ++ - "single static library that can be linked against." - , flagType = DynamicFlag - } - , flag { flagName = "-fPIC" - , flagDescription = - "Generate position-independent code (where available)" - , flagType = DynamicFlag - } - , flag { flagName = "-dynload" - , flagDescription = - "Selects one of a number of modes for finding shared libraries at runtime." - , flagType = DynamicFlag - } - , flag { flagName = "-framework ⟨name⟩" - , flagDescription = - "On Darwin/OS X/iOS only, link in the framework ⟨name⟩. This " ++ - "option corresponds to the ``-framework`` option for Apple's Linker." - , flagType = DynamicFlag - } - , flag { flagName = "-framework-path ⟨dir⟩" - , flagDescription = - "On Darwin/OS X/iOS only, add ⟨dir⟩ to the list of directories " ++ - "searched for frameworks. This option corresponds to the ``-F`` "++ - "option for Apple's Linker." - , flagType = DynamicFlag - } - , flag { flagName = "-l ⟨lib⟩" - , flagDescription = "Link in library ⟨lib⟩" - , flagType = DynamicFlag - } - , flag { flagName = "-L ⟨dir⟩" - , flagDescription = - "Add ⟨dir⟩ to the list of directories searched for libraries" - , flagType = DynamicFlag - } - , flag { flagName = "-main-is ⟨thing⟩" - , flagDescription = "Set main module and function" - , flagType = DynamicFlag - } - , flag { flagName = "--mk-dll" - , flagDescription = "DLL-creation mode (Windows only)" - , flagType = DynamicFlag - } - , flag { flagName = "-no-hs-main" - , flagDescription = "Don't assume this program contains ``main``" - , flagType = DynamicFlag - } - , flag { flagName = "-rtsopts[=⟨none|some|all⟩]" - , flagDescription = - "Control whether the RTS behaviour can be tweaked via command-line"++ - "flags and the ``GHCRTS`` environment variable. Using ``none`` " ++ - "means no RTS flags can be given; ``some`` means only a minimum " ++ - "of safe options can be given (the default), and ``all`` (or no " ++ - "argument at all) means that all RTS flags are permitted." - , flagType = DynamicFlag - } - , flag { flagName = "-with-rtsopts=⟨opts⟩" - , flagDescription = "Set the default RTS options to ⟨opts⟩." - , flagType = DynamicFlag - } - , flag { flagName = "-no-rtsopts-suggestions" - , flagDescription = - "Don't print RTS suggestions about linking with "++ - ":ghc-flag:`-rtsopts[=⟨none|some|all⟩]`." - , flagType = DynamicFlag - } - , flag { flagName = "-no-link" - , flagDescription = "Omit linking" - , flagType = DynamicFlag - } - , flag { flagName = "-split-objs" - , flagDescription = "Split objects (for libraries)" - , flagType = DynamicFlag - } - , flag { flagName = "-split-sections" - , flagDescription = "Split sections for link-time dead-code stripping" - , flagType = DynamicFlag - } - , flag { flagName = "-static" - , flagDescription = "Use static Haskell libraries" - , flagType = DynamicFlag - } - , flag { flagName = "-threaded" - , flagDescription = "Use the threaded runtime" - , flagType = DynamicFlag - } - , flag { flagName = "-debug" - , flagDescription = "Use the debugging runtime" - , flagType = DynamicFlag - } - , flag { flagName = "-ticky" - , flagDescription = - "For linking, this simply implies :ghc-flag:`-debug`; "++ - "see :ref:`ticky-ticky`." - , flagType = DynamicFlag - } - , flag { flagName = "-eventlog" - , flagDescription = "Enable runtime event tracing" - , flagType = DynamicFlag - } - , flag { flagName = "-fno-gen-manifest" - , flagDescription = "Do not generate a manifest file (Windows only)" - , flagType = DynamicFlag - } - , flag { flagName = "-fno-embed-manifest" - , flagDescription = - "Do not embed the manifest in the executable (Windows only)" - , flagType = DynamicFlag - } - , flag { flagName = "-fno-shared-implib" - , flagDescription = - "Don't generate an import library for a DLL (Windows only)" - , flagType = DynamicFlag - } - , flag { flagName = "-dylib-install-name ⟨path⟩" - , flagDescription = - "Set the install name (via ``-install_name`` passed to Apple's " ++ - "linker), specifying the full install path of the library file. " ++ - "Any libraries or executables that link with it later will pick " ++ - "up that path as their runtime search location for it. " ++ - "(Darwin/OS X only)" - , flagType = DynamicFlag - } - , flag { flagName = "-rdynamic" - , flagDescription = - "This instructs the linker to add all symbols, not only used " ++ - "ones, to the dynamic symbol table. Currently Linux and " ++ - "Windows/MinGW32 only. This is equivalent to using " ++ - "``-optl -rdynamic`` on Linux, and ``-optl -export-all-symbols`` " ++ - "on Windows." - , flagType = DynamicFlag - } - ] diff --git a/utils/mkUserGuidePart/Options/Misc.hs b/utils/mkUserGuidePart/Options/Misc.hs deleted file mode 100644 index f1d4336806..0000000000 --- a/utils/mkUserGuidePart/Options/Misc.hs +++ /dev/null @@ -1,40 +0,0 @@ -module Options.Misc where - -import Types - -miscOptions :: [Flag] -miscOptions = - [ flag { flagName = "-j[⟨n⟩]" - , flagDescription = - "When compiling with :ghc-flag:`--make`, compile ⟨n⟩ modules" ++ - " in parallel." - , flagType = DynamicFlag - } - , flag { flagName = "-fno-hi-version-check" - , flagDescription = "Don't complain about ``.hi`` file mismatches" - , flagType = DynamicFlag - } - , flag { flagName = "-fhistory-size" - , flagDescription = "Set simplification history size" - , flagType = DynamicFlag - } - , flag { flagName = "-fno-ghci-history" - , flagDescription = - "Do not use the load/store the GHCi command history from/to "++ - "``ghci_history``." - , flagType = DynamicFlag - } - , flag { flagName = "-fno-ghci-sandbox" - , flagDescription = - "Turn off the GHCi sandbox. Means computations are run in "++ - "the main thread, rather than a forked thread." - , flagType = DynamicFlag - } - , flag { flagName = "-flocal-ghci-history" - , flagDescription = - "Use current directory for the GHCi command history "++ - "file ``.ghci-history``." - , flagType = DynamicFlag - , flagReverse = "-fno-local-ghci-history" - } - ] diff --git a/utils/mkUserGuidePart/Options/Modes.hs b/utils/mkUserGuidePart/Options/Modes.hs deleted file mode 100644 index e0afb61999..0000000000 --- a/utils/mkUserGuidePart/Options/Modes.hs +++ /dev/null @@ -1,69 +0,0 @@ -module Options.Modes where - -import Types - -modeOptions :: [Flag] -modeOptions = - [ flag { flagName = "--help,-?" - , flagDescription = "Display help" - , flagType = ModeFlag - } - , flag { flagName = "--interactive" - , flagDescription = - "Interactive mode - normally used by just running ``ghci``; "++ - "see :ref:`ghci` for details." - , flagType = ModeFlag - } - , flag { flagName = "--make" - , flagDescription = - "Build a multi-module Haskell program, automatically figuring out "++ - "dependencies. Likely to be much easier, and faster, than using "++ - "``make``; see :ref:`make-mode` for details." - , flagType = ModeFlag - } - , flag { flagName = "-e ⟨expr⟩" - , flagDescription = - "Evaluate ``expr``; see :ref:`eval-mode` for details." - , flagType = ModeFlag - } - , flag { flagName = "--show-iface ⟨file⟩" - , flagDescription = "display the contents of an interface file." - , flagType = ModeFlag - } - , flag { flagName = "-M" - , flagDescription = - "generate dependency information suitable for use in a "++ - "``Makefile``; see :ref:`makefile-dependencies` for details." - , flagType = ModeFlag - } - , flag { flagName = "--frontend ⟨module⟩" - , flagDescription = - "run GHC with the given frontend plugin; see "++ - ":ref:`frontend_plugins` for details." - , flagType = ModeFlag - } - , flag { flagName = "--supported-extensions, --supported-languages" - , flagDescription = "display the supported language extensions" - , flagType = ModeFlag - } - , flag { flagName = "--show-options" - , flagDescription = "display the supported command line options" - , flagType = ModeFlag - } - , flag { flagName = "--info" - , flagDescription = "display information about the compiler" - , flagType = ModeFlag - } - , flag { flagName = "--version, -V" - , flagDescription = "display GHC version" - , flagType = ModeFlag - } - , flag { flagName = "--numeric-version" - , flagDescription = "display GHC version (numeric only)" - , flagType = ModeFlag - } - , flag { flagName = "--print-libdir" - , flagDescription = "display GHC library directory" - , flagType = ModeFlag - } - ] diff --git a/utils/mkUserGuidePart/Options/OptimizationLevels.hs b/utils/mkUserGuidePart/Options/OptimizationLevels.hs deleted file mode 100644 index a57fc5291b..0000000000 --- a/utils/mkUserGuidePart/Options/OptimizationLevels.hs +++ /dev/null @@ -1,29 +0,0 @@ -module Options.OptimizationLevels where - -import Types - -optimizationLevelsOptions :: [Flag] -optimizationLevelsOptions = - [ flag { flagName = "-O0" - , flagDescription = "Disable optimisations (default)" - , flagType = DynamicFlag - , flagReverse = "-O" - } - , flag { flagName = "-O, -O1" - , flagDescription = "Enable level 1 optimisations" - , flagType = DynamicFlag - , flagReverse = "-O0" - } - , flag { flagName = "-O2" - , flagDescription = "Enable level 2 optimisations" - , flagType = DynamicFlag - , flagReverse = "-O0" - } - , flag { flagName = "-Odph" - , flagDescription = - "Enable level 2 optimisations, set "++ - "``-fmax-simplifier-iterations=20`` "++ - "and ``-fsimplifier-phases=3``." - , flagType = DynamicFlag - } - ] diff --git a/utils/mkUserGuidePart/Options/Optimizations.hs b/utils/mkUserGuidePart/Options/Optimizations.hs deleted file mode 100644 index afefc6e2a5..0000000000 --- a/utils/mkUserGuidePart/Options/Optimizations.hs +++ /dev/null @@ -1,379 +0,0 @@ -module Options.Optimizations where - -import Types - -optimizationsOptions :: [Flag] -optimizationsOptions = - [ flag { flagName = "-fcall-arity" - , flagDescription = - "Enable call-arity optimisation. Implied by :ghc-flag:`-O`." - , flagType = DynamicFlag - , flagReverse = "-fno-call-arity" - } - , flag { flagName = "-fcase-merge" - , flagDescription = "Enable case-merging. Implied by :ghc-flag:`-O`." - , flagType = DynamicFlag - , flagReverse = "-fno-case-merge" - } - , flag { flagName = "-fcase-folding" - , flagDescription = "Enable constant folding in case expressions. Implied by :ghc-flag:`-O`." - , flagType = DynamicFlag - , flagReverse = "-fno-case-folding" - } - , flag { flagName = "-fcmm-elim-common-blocks" - , flagDescription = - "Enable Cmm common block elimination. Implied by :ghc-flag:`-O`." - , flagType = DynamicFlag - , flagReverse = "-fno-cmm-elim-common-blocks" - } - , flag { flagName = "-fcmm-sink" - , flagDescription = "Enable Cmm sinking. Implied by :ghc-flag:`-O`." - , flagType = DynamicFlag - , flagReverse = "-fno-cmm-sink" - } - , flag { flagName = "-fcpr-anal" - , flagDescription = - "Turn on CPR analysis in the demand analyser. Implied by :ghc-flag:`-O`." - , flagType = DynamicFlag - , flagReverse = "-fno-cpr-anal" - } - , flag { flagName = "-fcse" - , flagDescription = - "Enable common sub-expression elimination. Implied by :ghc-flag:`-O`." - , flagType = DynamicFlag - , flagReverse = "-fno-cse" - } - , flag { flagName = "-fdicts-cheap" - , flagDescription = - "Make dictionary-valued expressions seem cheap to the optimiser." - , flagType = DynamicFlag - , flagReverse = "-fno-dicts-cheap" - } - , flag { flagName = "-fdicts-strict" - , flagDescription = "Make dictionaries strict" - , flagType = DynamicFlag - , flagReverse = "-fno-dicts-strict" - } - , flag { flagName = "-fdmd-tx-dict-sel" - , flagDescription = - "Use a special demand transformer for dictionary selectors. "++ - "Always enabled by default." - , flagType = DynamicFlag - , flagReverse = "-fno-dmd-tx-dict-sel" - } - , flag { flagName = "-fdo-eta-reduction" - , flagDescription = "Enable eta-reduction. Implied by :ghc-flag:`-O`." - , flagType = DynamicFlag - , flagReverse = "-fno-do-eta-reduction" - } - , flag { flagName = "-fdo-lambda-eta-expansion" - , flagDescription = - "Enable lambda eta-expansion. Always enabled by default." - , flagType = DynamicFlag - , flagReverse = "-fno-do-lambda-eta-expansion" - } - , flag { flagName = "-feager-blackholing" - , flagDescription = - "Turn on :ref:`eager blackholing <parallel-compile-options>`" - , flagType = DynamicFlag - } - , flag { flagName = "-fenable-rewrite-rules" - , flagDescription = - "Switch on all rewrite rules (including rules generated by "++ - "automatic specialisation of overloaded functions). Implied by "++ - ":ghc-flag:`-O`." - , flagType = DynamicFlag - , flagReverse = "-fno-enable-rewrite-rules" - } - , flag { flagName = "-fexcess-precision" - , flagDescription = "Enable excess intermediate precision" - , flagType = DynamicFlag - , flagReverse = "-fno-excess-precision" - } - , flag { flagName = "-fexpose-all-unfoldings" - , flagDescription = - "Expose all unfoldings, even for very large or recursive functions." - , flagType = DynamicFlag - , flagReverse = "-fno-expose-all-unfoldings" - } - , flag { flagName = "-ffloat-in" - , flagDescription = - "Turn on the float-in transformation. Implied by :ghc-flag:`-O`." - , flagType = DynamicFlag - , flagReverse = "-fno-float-in" - } - , flag { flagName = "-ffull-laziness" - , flagDescription = - "Turn on full laziness (floating bindings outwards). "++ - "Implied by :ghc-flag:`-O`." - , flagType = DynamicFlag - , flagReverse = "-fno-full-laziness" - } - , flag { flagName = "-ffun-to-thunk" - , flagDescription = - "Allow worker-wrapper to convert a function closure into a thunk "++ - "if the function does not use any of its arguments. Off by default." - , flagType = DynamicFlag - , flagReverse = "-fno-fun-to-thunk" - } - , flag { flagName = "-fignore-asserts" - , flagDescription = - "Ignore assertions in the source. Implied by :ghc-flag:`-O`." - , flagType = DynamicFlag - , flagReverse = "-fno-ignore-asserts" - } - , flag { flagName = "-fignore-interface-pragmas" - , flagDescription = - "Ignore pragmas in interface files. Implied by :ghc-flag:`-O0` only." - , flagType = DynamicFlag - , flagReverse = "-fno-ignore-interface-pragmas" - } - , flag { flagName = "-flate-dmd-anal" - , flagDescription = - "Run demand analysis again, at the end of the "++ - "simplification pipeline" - , flagType = DynamicFlag - , flagReverse = "-fno-late-dmd-anal" - } - , flag { flagName = "-fliberate-case" - , flagDescription = - "Turn on the liberate-case transformation. Implied by :ghc-flag:`-O2`." - , flagType = DynamicFlag - , flagReverse = "-fno-liberate-case" - } - , flag { flagName = "-fliberate-case-threshold=⟨n⟩" - , flagDescription = - "*default: 2000.* Set the size threshold for the liberate-case "++ - "transformation to ⟨n⟩" - , flagType = DynamicFlag - , flagReverse = "-fno-liberate-case-threshold" - } - , flag { flagName = "-floopification" - , flagDescription = - "Turn saturated self-recursive tail-calls into local jumps in the "++ - "generated assembly. Implied by :ghc-flag:`-O`." - , flagType = DynamicFlag - , flagReverse = "-fno-loopification" - } - , flag { flagName = "-fmax-inline-alloc-size=⟨n⟩" - , flagDescription = - "*default: 128.* Set the maximum size of inline array allocations "++ - "to ⟨n⟩ bytes (default: 128). GHC will allocate non-pinned arrays "++ - "of statically known size in the current nursery block if they're "++ - "no bigger than ⟨n⟩ bytes, ignoring GC overheap. This value should "++ - "be quite a bit smaller than the block size (typically: 4096)." - , flagType = DynamicFlag - } - , flag { flagName = "-fmax-inline-memcpy-insns=⟨n⟩" - , flagDescription = - "*default: 32.* Inline ``memcpy`` calls if they would generate no "++ - "more than ⟨n⟩ pseudo instructions." - , flagType = DynamicFlag - } - , flag { flagName = "-fmax-inline-memset-insns=⟨n⟩" - , flagDescription = - "*default: 32.* Inline ``memset`` calls if they would generate no "++ - "more than ⟨n⟩ pseudo instructions" - , flagType = DynamicFlag - } - , flag { flagName = "-fmax-relevant-binds=⟨n⟩" - , flagDescription = - "*default: 6.* Set the maximum number of bindings to display in "++ - "type error messages." - , flagType = DynamicFlag - , flagReverse = "-fno-max-relevant-bindings" - } - , flag { flagName = "-fmax-valid-substitutions=⟨n⟩" - , flagDescription = - "*default: 6.* Set the maximum number of valid substitutions for"++ - "typed holes to display in type error messages." - , flagType = DynamicFlag - , flagReverse = "-fno-max-valid-substitutions" - } - , flag { flagName = "-fmax-uncovered-patterns=⟨n⟩" - , flagDescription = - "*default: 4.* Set the maximum number of patterns to display in "++ - "warnings about non-exhaustive ones." - , flagType = DynamicFlag - } - , flag { flagName = "-fmax-simplifier-iterations=⟨n⟩" - , flagDescription = - "*default: 4.* Set the max iterations for the simplifier." - , flagType = DynamicFlag - } - , flag { flagName = "-fmax-worker-args=⟨n⟩" - , flagDescription = - "*default: 10.* If a worker has that many arguments, none will "++ - "be unpacked anymore." - , flagType = DynamicFlag - } - , flag { flagName = "-fno-opt-coercion" - , flagDescription = "Turn off the coercion optimiser" - , flagType = DynamicFlag - } - , flag { flagName = "-fno-pre-inlining" - , flagDescription = "Turn off pre-inlining" - , flagType = DynamicFlag - } - , flag { flagName = "-fno-state-hack" - , flagDescription = - "Turn off the \"state hack\" whereby any lambda with a real-world "++ - "state token as argument is considered to be single-entry. Hence "++ - "OK to inline things inside it." - , flagType = DynamicFlag - } - , flag { flagName = "-fomit-interface-pragmas" - , flagDescription = - "Don't generate interface pragmas. Implied by :ghc-flag:`-O0` only." - , flagType = DynamicFlag - , flagReverse = "-fno-omit-interface-pragmas" - } - , flag { flagName = "-fomit-yields" - , flagDescription = - "Omit heap checks when no allocation is being performed." - , flagType = DynamicFlag - , flagReverse = "-fno-omit-yields" - } - , flag { flagName = "-foptimal-applicative-do" - , flagDescription = - "Use a slower but better algorithm for ApplicativeDo" - , flagType = DynamicFlag - , flagReverse = "-fno-optimal-applicative-do" - } - , flag { flagName = "-fpedantic-bottoms" - , flagDescription = - "Make GHC be more precise about its treatment of bottom (but see "++ - "also :ghc-flag:`-fno-state-hack`). In particular, GHC will not "++ - "eta-expand through a case expression." - , flagType = DynamicFlag - , flagReverse = "-fno-pedantic-bottoms" - } - , flag { flagName = "-fregs-graph" - , flagDescription = - "Use the graph colouring register allocator for register "++ - "allocation in the native code generator. Implied by :ghc-flag:`-O2`." - , flagType = DynamicFlag - , flagReverse = "-fno-regs-graph" - } - , flag { flagName = "-fregs-iterative" - , flagDescription = - "Use the iterative coalescing graph colouring register allocator "++ - "in the native code generator." - , flagType = DynamicFlag - , flagReverse = "-fno-regs-iterative" - } - , flag { flagName = "-fsimplifier-phases=⟨n⟩" - , flagDescription = - "*default: 2.* Set the number of phases for the simplifier. "++ - "Ignored with :ghc-flag:`-O0`." - , flagType = DynamicFlag - } - , flag { flagName = "-fsimpl-tick-factor=⟨n⟩" - , flagDescription = - "*default: 100.* Set the percentage factor for simplifier ticks." - , flagType = DynamicFlag - } - , flag { flagName = "-fspec-constr" - , flagDescription = - "Turn on the SpecConstr transformation. Implied by :ghc-flag:`-O2`." - , flagType = DynamicFlag - , flagReverse = "-fno-spec-constr" - } - , flag { flagName = "-fspec-constr-count=⟨n⟩" - , flagDescription = - "default: 3.* Set to ⟨n⟩ the maximum number of specialisations that"++ - " will be created for any one function by the SpecConstr "++ - "transformation." - , flagType = DynamicFlag - , flagReverse = "-fno-spec-constr-count" - } - , flag { flagName = "-fspec-constr-threshold=⟨n⟩" - , flagDescription = - "*default: 2000.* Set the size threshold for the SpecConstr "++ - "transformation to ⟨n⟩." - , flagType = DynamicFlag - , flagReverse = "-fno-spec-constr-threshold" - } - , flag { flagName = "-fspecialise" - , flagDescription = - "Turn on specialisation of overloaded functions. Implied by :ghc-flag:`-O`." - , flagType = DynamicFlag - , flagReverse = "-fno-specialise" - } - , flag { flagName = "-fcross-module-specialise" - , flagDescription = - "Turn on specialisation of overloaded functions imported from "++ - "other modules." - , flagType = DynamicFlag - , flagReverse = "-fno-cross-module-specialise" - } - , flag { flagName = "-fstatic-argument-transformation" - , flagDescription = "Turn on the static argument transformation." - , flagType = DynamicFlag - , flagReverse = "-fno-static-argument-transformation" - } - , flag { flagName = "-fstrictness" - , flagDescription = "Turn on strictness analysis." ++ - " Implied by :ghc-flag:`-O`. Implies :ghc-flag:`-fworker-wrapper`" - , flagType = DynamicFlag - , flagReverse = "-fno-strictness" - } - , flag { flagName = "-fstrictness-before=⟨n⟩" - , flagDescription = - "Run an additional strictness analysis before simplifier phase ⟨n⟩" - , flagType = DynamicFlag - } - , flag { flagName = "-funbox-small-strict-fields" - , flagDescription = - "Flatten strict constructor fields with a pointer-sized "++ - "representation. Implied by :ghc-flag:`-O`." - , flagType = DynamicFlag - , flagReverse = "-fno-unbox-small-strict-fields" - } - , flag { flagName = "-funbox-strict-fields" - , flagDescription = "Flatten strict constructor fields" - , flagType = DynamicFlag - , flagReverse = "-fno-unbox-strict-fields" - } - , flag { flagName = "-funfolding-creation-threshold=⟨n⟩" - , flagDescription = "*default: 750.* Tweak unfolding settings." - , flagType = DynamicFlag - } - , flag { flagName = "-funfolding-dict-discount=⟨n⟩" - , flagDescription = "*default: 30.* Tweak unfolding settings." - , flagType = DynamicFlag - } - , flag { flagName = "-funfolding-fun-discount=⟨n⟩" - , flagDescription = "*default: 60.* Tweak unfolding settings." - , flagType = DynamicFlag - } - , flag { flagName = "-funfolding-keeness-factor=⟨n⟩" - , flagDescription = "*default: 1.5.* Tweak unfolding settings." - , flagType = DynamicFlag - } - , flag { flagName = "-funfolding-use-threshold=⟨n⟩" - , flagDescription = "*default: 60.* Tweak unfolding settings." - , flagType = DynamicFlag - } - , flag { flagName = "-fvectorisation-avoidance" - , flagDescription = - "Enable vectorisation avoidance. Always enabled by default." - , flagType = DynamicFlag - , flagReverse = "-fno-vectorisation-avoidance" - } - , flag { flagName = "-fvectorise" - , flagDescription = "Enable vectorisation of nested data parallelism" - , flagType = DynamicFlag - , flagReverse = "-fno-vectorise" - } - , flag { flagName = "-fworker-wrapper" - , flagDescription = - "Enable the worker-wrapper transformation after a strictness" ++ - " analysis pass. Implied by :ghc-flag:`-O`, and by :ghc-flag:`-fstrictness`." ++ - " Disabled by :ghc-flag:`-fno-strictness`. Enabling :ghc-flag:`-fworker-wrapper`" ++ - " while strictness analysis is disabled (by :ghc-flag:`-fno-strictness`)" ++ - " has no effect." - , flagType = DynamicFlag - , flagReverse = "-fno-worker-wrapper" - } - ] diff --git a/utils/mkUserGuidePart/Options/Packages.hs b/utils/mkUserGuidePart/Options/Packages.hs deleted file mode 100644 index d2aed64c63..0000000000 --- a/utils/mkUserGuidePart/Options/Packages.hs +++ /dev/null @@ -1,75 +0,0 @@ -module Options.Packages where - -import Types - -packagesOptions :: [Flag] -packagesOptions = - [ flag { flagName = "-this-unit-id ⟨unit-id⟩" - , flagDescription = - "Compile to be part of unit (i.e. package)" ++ - " ⟨unit-id⟩" - , flagType = DynamicFlag - } - , flag { flagName = "-package ⟨pkg⟩" - , flagDescription = "Expose package ⟨pkg⟩" - , flagType = DynamicSettableFlag - } - , flag { flagName = "-hide-all-packages" - , flagDescription = "Hide all packages by default" - , flagType = DynamicFlag - } - , flag { flagName = "-hide-package ⟨pkg⟩" - , flagDescription = "Hide package ⟨pkg⟩" - , flagType = DynamicSettableFlag - } - , flag { flagName = "-ignore-package ⟨pkg⟩" - , flagDescription = "Ignore package ⟨pkg⟩" - , flagType = DynamicSettableFlag - } - , flag { flagName = "-package-db ⟨file⟩" - , flagDescription = "Add ⟨file⟩ to the package db stack." - , flagType = DynamicFlag - } - , flag { flagName = "-clear-package-db" - , flagDescription = "Clear the package db stack." - , flagType = DynamicFlag - } - , flag { flagName = "-no-global-package-db" - , flagDescription = "Remove the global package db from the stack." - , flagType = DynamicFlag - } - , flag { flagName = "-global-package-db" - , flagDescription = "Add the global package db to the stack." - , flagType = DynamicFlag - } - , flag { flagName = "-no-user-package-db" - , flagDescription = "Remove the user's package db from the stack." - , flagType = DynamicFlag - } - , flag { flagName = "-user-package-db" - , flagDescription = "Add the user's package db to the stack." - , flagType = DynamicFlag - } - , flag { flagName = "-no-auto-link-packages" - , flagDescription = - "Don't automatically link in the base and rts packages." - , flagType = DynamicFlag - } - , flag { flagName = "-trust ⟨pkg⟩" - , flagDescription = "Expose package ⟨pkg⟩ and set it to be trusted" - , flagType = DynamicSettableFlag - } - , flag { flagName = "-distrust ⟨pkg⟩" - , flagDescription = - "Expose package ⟨pkg⟩ and set it to be distrusted" - , flagType = DynamicSettableFlag - } - , flag { flagName = "-distrust-all" - , flagDescription = "Distrust all packages by default" - , flagType = DynamicSettableFlag - } - , flag { flagName = "-package-env ⟨file⟩|⟨name⟩" - , flagDescription = "Use the specified package environment." - , flagType = DynamicFlag - } - ] diff --git a/utils/mkUserGuidePart/Options/PhasePrograms.hs b/utils/mkUserGuidePart/Options/PhasePrograms.hs deleted file mode 100644 index 9e13fb8b26..0000000000 --- a/utils/mkUserGuidePart/Options/PhasePrograms.hs +++ /dev/null @@ -1,58 +0,0 @@ -module Options.PhasePrograms where - -import Types - -phaseProgramsOptions :: [Flag] -phaseProgramsOptions = - [ flag { flagName = "-pgmL ⟨cmd⟩" - , flagDescription = "Use ⟨cmd⟩ as the literate pre-processor" - , flagType = DynamicFlag - } - , flag { flagName = "-pgmP ⟨cmd⟩" - , flagDescription = - "Use ⟨cmd⟩ as the C pre-processor (with ``-cpp`` only)" - , flagType = DynamicFlag - } - , flag { flagName = "-pgmc ⟨cmd⟩" - , flagDescription = "Use ⟨cmd⟩ as the C compiler" - , flagType = DynamicFlag - } - , flag { flagName = "-pgmlo ⟨cmd⟩" - , flagDescription = "Use ⟨cmd⟩ as the LLVM optimiser" - , flagType = DynamicFlag - } - , flag { flagName = "-pgmlc ⟨cmd⟩" - , flagDescription = "Use ⟨cmd⟩ as the LLVM compiler" - , flagType = DynamicFlag - } - , flag { flagName = "-pgms ⟨cmd⟩" - , flagDescription = "Use ⟨cmd⟩ as the splitter" - , flagType = DynamicFlag - } - , flag { flagName = "-pgma ⟨cmd⟩" - , flagDescription = "Use ⟨cmd⟩ as the assembler" - , flagType = DynamicFlag - } - , flag { flagName = "-pgml ⟨cmd⟩" - , flagDescription = "Use ⟨cmd⟩ as the linker" - , flagType = DynamicFlag - } - , flag { flagName = "-pgmdll ⟨cmd⟩" - , flagDescription = "Use ⟨cmd⟩ as the DLL generator" - , flagType = DynamicFlag - } - , flag { flagName = "-pgmF ⟨cmd⟩" - , flagDescription = "Use ⟨cmd⟩ as the pre-processor (with ``-F`` only)" - , flagType = DynamicFlag - } - , flag { flagName = "-pgmwindres ⟨cmd⟩" - , flagDescription = - "Use ⟨cmd⟩ as the program for embedding manifests on Windows." - , flagType = DynamicFlag - } - , flag { flagName = "-pgmlibtool ⟨cmd⟩" - , flagDescription = - "Use ⟨cmd⟩ as the command for libtool (with ``-staticlib`` only)." - , flagType = DynamicFlag - } - ] diff --git a/utils/mkUserGuidePart/Options/PhaseSpecific.hs b/utils/mkUserGuidePart/Options/PhaseSpecific.hs deleted file mode 100644 index bf903bc8f3..0000000000 --- a/utils/mkUserGuidePart/Options/PhaseSpecific.hs +++ /dev/null @@ -1,47 +0,0 @@ -module Options.PhaseSpecific where - -import Types - -phaseSpecificOptions :: [Flag] -phaseSpecificOptions = - [ flag { flagName = "-optL ⟨option⟩" - , flagDescription = "pass ⟨option⟩ to the literate pre-processor" - , flagType = DynamicFlag - } - , flag { flagName = "-optP ⟨option⟩" - , flagDescription = "pass ⟨option⟩ to cpp (with ``-cpp`` only)" - , flagType = DynamicFlag - } - , flag { flagName = "-optF ⟨option⟩" - , flagDescription = "pass ⟨option⟩ to the custom pre-processor" - , flagType = DynamicFlag - } - , flag { flagName = "-optc ⟨option⟩" - , flagDescription = "pass ⟨option⟩ to the C compiler" - , flagType = DynamicFlag - } - , flag { flagName = "-optlo ⟨option⟩" - , flagDescription = "pass ⟨option⟩ to the LLVM optimiser" - , flagType = DynamicFlag - } - , flag { flagName = "-optlc ⟨option⟩" - , flagDescription = "pass ⟨option⟩ to the LLVM compiler" - , flagType = DynamicFlag - } - , flag { flagName = "-opta ⟨option⟩" - , flagDescription = "pass ⟨option⟩ to the assembler" - , flagType = DynamicFlag - } - , flag { flagName = "-optl ⟨option⟩" - , flagDescription = "pass ⟨option⟩ to the linker" - , flagType = DynamicFlag - } - , flag { flagName = "-optdll ⟨option⟩" - , flagDescription = "pass ⟨option⟩ to the DLL generator" - , flagType = DynamicFlag - } - , flag { flagName = "-optwindres ⟨option⟩" - , flagDescription = "pass ⟨option⟩ to ``windres``." - , flagType = DynamicFlag - } - ] diff --git a/utils/mkUserGuidePart/Options/Phases.hs b/utils/mkUserGuidePart/Options/Phases.hs deleted file mode 100644 index 54c886e310..0000000000 --- a/utils/mkUserGuidePart/Options/Phases.hs +++ /dev/null @@ -1,33 +0,0 @@ -module Options.Phases where - -import Types - -phaseOptions :: [Flag] -phaseOptions = - [ flag { flagName = "-F" - , flagDescription = - "Enable the use of a :ref:`pre-processor <pre-processor>` "++ - "(set with :ghc-flag:`-pgmF ⟨cmd⟩`)" - , flagType = DynamicFlag - } - , flag { flagName = "-E" - , flagDescription = "Stop after preprocessing (``.hspp`` file)" - , flagType = ModeFlag - } - , flag { flagName = "-C" - , flagDescription = "Stop after generating C (``.hc`` file)" - , flagType = ModeFlag - } - , flag { flagName = "-S" - , flagDescription = "Stop after generating assembly (``.s`` file)" - , flagType = ModeFlag - } - , flag { flagName = "-c" - , flagDescription = "Stop after generating object (``.o``) file" - , flagType = ModeFlag - } - , flag { flagName = "-x ⟨suffix⟩" - , flagDescription = "Override default behaviour for source files" - , flagType = DynamicFlag - } - ] diff --git a/utils/mkUserGuidePart/Options/PlatformSpecific.hs b/utils/mkUserGuidePart/Options/PlatformSpecific.hs deleted file mode 100644 index 8d43665ea9..0000000000 --- a/utils/mkUserGuidePart/Options/PlatformSpecific.hs +++ /dev/null @@ -1,15 +0,0 @@ -module Options.PlatformSpecific where - -import Types - -platformSpecificOptions :: [Flag] -platformSpecificOptions = - [ flag { flagName = "-msse2" - , flagDescription = "(x86 only) Use SSE2 for floating-point operations" - , flagType = DynamicFlag - } - , flag { flagName = "-msse4.2" - , flagDescription = "(x86 only) Use SSE4.2 for floating-point operations" - , flagType = DynamicFlag - } - ] diff --git a/utils/mkUserGuidePart/Options/Plugin.hs b/utils/mkUserGuidePart/Options/Plugin.hs deleted file mode 100644 index a948b94c9f..0000000000 --- a/utils/mkUserGuidePart/Options/Plugin.hs +++ /dev/null @@ -1,17 +0,0 @@ -module Options.Plugin where - -import Types - -pluginOptions :: [Flag] -pluginOptions = - [ flag { flagName = "-fplugin=⟨module⟩" - , flagDescription = "Load a plugin exported by a given module" - , flagType = DynamicFlag - } - , flag { flagName = "-fplugin-opt=⟨module⟩:⟨args⟩" - , flagDescription = - "Give arguments to a plugin module; module must be specified with "++ - "``-fplugin``" - , flagType = DynamicFlag - } - ] diff --git a/utils/mkUserGuidePart/Options/Profiling.hs b/utils/mkUserGuidePart/Options/Profiling.hs deleted file mode 100644 index af3853fafc..0000000000 --- a/utils/mkUserGuidePart/Options/Profiling.hs +++ /dev/null @@ -1,44 +0,0 @@ -module Options.Profiling where - -import Types - -profilingOptions :: [Flag] -profilingOptions = - [ flag { flagName = "-prof" - , flagDescription = "Turn on profiling" - , flagType = DynamicFlag - } - , flag { flagName = "-fprof-auto" - , flagDescription = - "Auto-add ``SCC``\\ s to all bindings not marked INLINE" - , flagType = DynamicFlag - , flagReverse = "-fno-prof-auto" - } - , flag { flagName = "-fprof-auto-top" - , flagDescription = - "Auto-add ``SCC``\\ s to all top-level bindings not marked INLINE" - , flagType = DynamicFlag - , flagReverse = "-fno-prof-auto" - } - , flag { flagName = "-fprof-auto-exported" - , flagDescription = - "Auto-add ``SCC``\\ s to all exported bindings not marked INLINE" - , flagType = DynamicFlag - , flagReverse = "-fno-prof-auto" - } - , flag { flagName = "-fprof-cafs" - , flagDescription = "Auto-add ``SCC``\\ s to all CAFs" - , flagType = DynamicFlag - , flagReverse = "-fno-prof-cafs" - } - , flag { flagName = "-fno-prof-count-entries" - , flagDescription = "Do not collect entry counts" - , flagType = DynamicFlag - , flagReverse = "-fprof-count-entries" - } - , flag { flagName = "-ticky" - , flagDescription = - ":ref:`Turn on ticky-ticky profiling <ticky-ticky>`" - , flagType = DynamicFlag - } - ] diff --git a/utils/mkUserGuidePart/Options/ProgramCoverage.hs b/utils/mkUserGuidePart/Options/ProgramCoverage.hs deleted file mode 100644 index 8da7df37b7..0000000000 --- a/utils/mkUserGuidePart/Options/ProgramCoverage.hs +++ /dev/null @@ -1,18 +0,0 @@ -module Options.ProgramCoverage where - -import Types - -programCoverageOptions :: [Flag] -programCoverageOptions = - [ flag { flagName = "-fhpc" - , flagDescription = - "Turn on Haskell program coverage instrumentation" - , flagType = DynamicFlag - } - , flag { flagName = "-hpcdir ⟨dir⟩" - , flagDescription = - "Directory to deposit ``.mix`` files during compilation "++ - "(default is ``.hpc``)" - , flagType = DynamicFlag - } - ] diff --git a/utils/mkUserGuidePart/Options/RecompilationChecking.hs b/utils/mkUserGuidePart/Options/RecompilationChecking.hs deleted file mode 100644 index f119c1111e..0000000000 --- a/utils/mkUserGuidePart/Options/RecompilationChecking.hs +++ /dev/null @@ -1,15 +0,0 @@ -module Options.RecompilationChecking where - -import Types - -recompilationCheckingOptions :: [Flag] -recompilationCheckingOptions = - [ flag { flagName = "-fforce-recomp" - , flagDescription = - "Turn off recompilation checking. This is implied by any " ++ - "``-ddump-X`` option when compiling a single file " ++ - "(i.e. when using :ghc-flag:`-c`)." - , flagType = DynamicFlag - , flagReverse = "-fno-force-recomp" - } - ] diff --git a/utils/mkUserGuidePart/Options/RedirectingOutput.hs b/utils/mkUserGuidePart/Options/RedirectingOutput.hs deleted file mode 100644 index 162131166c..0000000000 --- a/utils/mkUserGuidePart/Options/RedirectingOutput.hs +++ /dev/null @@ -1,59 +0,0 @@ -module Options.RedirectingOutput where - -import Types - -redirectingOutputOptions :: [Flag] -redirectingOutputOptions = - [ flag { flagName = "-hcsuf ⟨suffix⟩" - , flagDescription = "set the suffix to use for intermediate C files" - , flagType = DynamicFlag - } - , flag { flagName = "-hidir ⟨dir⟩" - , flagDescription = "set directory for interface files" - , flagType = DynamicFlag - } - , flag { flagName = "-hisuf ⟨suffix⟩" - , flagDescription = "set the suffix to use for interface files" - , flagType = DynamicFlag - } - , flag { flagName = "-o ⟨file⟩" - , flagDescription = "set output filename" - , flagType = DynamicFlag - } - , flag { flagName = "-odir ⟨dir⟩" - , flagDescription = "set directory for object files" - , flagType = DynamicFlag - } - , flag { flagName = "-ohi ⟨file⟩" - , flagDescription = "set the filename in which to put the interface" - , flagType = DynamicFlag - } - , flag { flagName = "-osuf ⟨suffix⟩" - , flagDescription = "set the output file suffix" - , flagType = DynamicFlag - } - , flag { flagName = "-stubdir ⟨dir⟩" - , flagDescription = "redirect FFI stub files" - , flagType = DynamicFlag - } - , flag { flagName = "-dumpdir ⟨dir⟩" - , flagDescription = "redirect dump files" - , flagType = DynamicFlag - } - , flag { flagName = "-outputdir ⟨dir⟩" - , flagDescription = "set output directory" - , flagType = DynamicFlag - } - , flag { flagName = "-dyno ⟨file⟩" - , flagDescription = "Set the output filename for dynamic object files (see ``-dynamic-too``)" - , flagType = DynamicFlag - } - , flag { flagName = "-dynosuf ⟨suffix⟩" - , flagDescription = "Set the object suffix for dynamic object files (see ``-dynamic-too``)" - , flagType = DynamicFlag - } - , flag { flagName = "-dynhisuf ⟨suffix⟩" - , flagDescription = "Set the hi suffix for dynamic object files (see ``-dynamic-too``)" - , flagType = DynamicFlag - } - ] diff --git a/utils/mkUserGuidePart/Options/TemporaryFiles.hs b/utils/mkUserGuidePart/Options/TemporaryFiles.hs deleted file mode 100644 index a66ca3b967..0000000000 --- a/utils/mkUserGuidePart/Options/TemporaryFiles.hs +++ /dev/null @@ -1,11 +0,0 @@ -module Options.TemporaryFiles where - -import Types - -temporaryFilesOptions :: [Flag] -temporaryFilesOptions = - [ flag { flagName = "-tmpdir ⟨dir⟩" - , flagDescription = "set the directory for temporary files" - , flagType = DynamicFlag - } - ] diff --git a/utils/mkUserGuidePart/Options/Verbosity.hs b/utils/mkUserGuidePart/Options/Verbosity.hs deleted file mode 100644 index aa608769b7..0000000000 --- a/utils/mkUserGuidePart/Options/Verbosity.hs +++ /dev/null @@ -1,88 +0,0 @@ -module Options.Verbosity where - -import Types - -verbosityOptions :: [Flag] -verbosityOptions = - [ flag { flagName = "-v" - , flagDescription = "verbose mode (equivalent to ``-v3``)" - , flagType = DynamicFlag - } - , flag { flagName = "-v ⟨n⟩" - , flagDescription = "set verbosity level" - , flagType = DynamicFlag - , flagReverse = "" - } - , flag { flagName = "-fhide-source-paths" - , flagDescription = "hide module source and object paths" - , flagType = DynamicFlag - , flagReverse = "" - } - , flag { flagName = "-fprint-potential-instances" - , flagDescription = - "display all available instances in type error messages" - , flagType = DynamicFlag - , flagReverse = "-fno-print-potential-instances" - } - , flag { flagName = "-fprint-explicit-foralls" - , flagDescription = - "Print explicit ``forall`` quantification in types. " ++ - "See also :ghc-flag:`-XExplicitForAll`" - , flagType = DynamicFlag - , flagReverse = "-fno-print-explicit-foralls" - } - , flag { flagName = "-fprint-explicit-kinds" - , flagDescription = - "Print explicit kind foralls and kind arguments in types. " ++ - "See also :ghc-flag:`-XKindSignatures`" - , flagType = DynamicFlag - , flagReverse = "-fno-print-explicit-kinds" - } - , flag { flagName = "-fprint-explicit-runtime-reps" - , flagDescription = - "Print ``RuntimeRep`` variables in types which are "++ - "runtime-representation polymorphic." - , flagType = DynamicFlag - , flagReverse = "-fno-print-explicit-runtime-reps" - } - , flag { flagName = "-fprint-unicode-syntax" - , flagDescription = - "Use unicode syntax when printing expressions, types and kinds. " ++ - "See also :ghc-flag:`-XUnicodeSyntax`" - , flagType = DynamicFlag - , flagReverse = "-fno-print-unicode-syntax" - } - , flag { flagName = "-fprint-expanded-synonyms" - , flagDescription = - "In type errors, also print type-synonym-expanded types." - , flagType = DynamicFlag - , flagReverse = "-fno-print-expanded-synonyms" - } - , flag { flagName = "-fprint-typechecker-elaboration" - , flagDescription = - "Print extra information from typechecker." - , flagType = DynamicFlag - , flagReverse = "-fno-print-typechecker-elaboration" - } - , flag { flagName = "-fdiagnostics-color=(always|auto|never)" - , flagDescription = "Use colors in error messages" - , flagType = DynamicFlag - } - , flag { flagName = "-f[no-]diagnostics-show-caret" - , flagDescription = "Whether to show snippets of original source code" - , flagType = DynamicFlag - } - , flag { flagName = "-ferror-spans" - , flagDescription = "Output full span in error messages" - , flagType = DynamicFlag - } - , flag { flagName = "-Rghc-timing" - , flagDescription = - "Summarise timing stats for GHC (same as ``+RTS -tstderr``)." - , flagType = DynamicFlag - } - , flag { flagName = "-fshow-hole-constraints" - , flagDescription = "Show constraints when reporting typed holes" - , flagType = DynamicFlag - } - ] diff --git a/utils/mkUserGuidePart/Options/Warnings.hs b/utils/mkUserGuidePart/Options/Warnings.hs deleted file mode 100644 index da88ec68b6..0000000000 --- a/utils/mkUserGuidePart/Options/Warnings.hs +++ /dev/null @@ -1,477 +0,0 @@ -module Options.Warnings where - -import Types - -warningsOptions :: [Flag] -warningsOptions = - [ flag { flagName = "-W" - , flagDescription = "enable normal warnings" - , flagType = DynamicFlag - , flagReverse = "-w" - } - , flag { flagName = "-w" - , flagDescription = "disable all warnings" - , flagType = DynamicFlag - } - , flag { flagName = "-Wall" - , flagDescription = - "enable almost all warnings (details in :ref:`options-sanity`)" - , flagType = DynamicFlag - , flagReverse = "-w" - } - , flag { flagName = "-Wcompat" - , flagDescription = - "enable future compatibility warnings " ++ - "(details in :ref:`options-sanity`)" - , flagType = DynamicFlag - , flagReverse = "-Wno-compat" - } - , flag { flagName = "-Werror" - , flagDescription = "make warnings fatal" - , flagType = DynamicFlag - , flagReverse = "-Wwarn" - } - , flag { flagName = "-Werror=⟨wflag⟩" - , flagDescription = "make a specific warning fatal" - , flagType = DynamicFlag - , flagReverse = "-Wwarn=⟨wflag⟩" - } - , flag { flagName = "-Wwarn" - , flagDescription = "make warnings non-fatal" - , flagType = DynamicFlag - , flagReverse = "-Werror" - } - , flag { flagName = "-Wwarn=⟨wflag⟩" - , flagDescription = "make a specific warning non-fatal" - , flagType = DynamicFlag - , flagReverse = "-Werror=⟨wflag⟩" - } - , flag { flagName = "-Wunrecognised-warning-flags" - , flagDescription = - "throw a warning when an unreconised ``-W...`` flag is "++ - "encountered on the command line." - , flagType = DynamicFlag - , flagReverse = "-Wno-unrecognised-warning-flags" - } - , flag { flagName = "-fshow-warning-groups" - , flagDescription = "show which group an emitted warning belongs to." - , flagType = DynamicFlag - , flagReverse = "-fno-show-warning-groups" - } - , flag { flagName = "-fdefer-type-errors" - , flagDescription = - "Turn type errors into warnings, :ref:`deferring the error until "++ - "runtime <defer-type-errors>`. Implies "++ - ":ghc-flag:`-fdefer-typed-holes` and "++ - ":ghc-flag:`-fdefer-out-of-scope-variables`. "++ - "See also :ghc-flag:`-Wdeferred-type-errors`" - , flagType = DynamicFlag - , flagReverse = "-fno-defer-type-errors" - } - , flag { flagName = "-fdefer-typed-holes" - , flagDescription = - "Convert :ref:`typed hole <typed-holes>` errors into warnings, "++ - ":ref:`deferring the error until runtime <defer-type-errors>`. "++ - "Implied by :ghc-flag:`-fdefer-type-errors`. "++ - "See also :ghc-flag:`-Wtyped-holes`." - , flagType = DynamicFlag - , flagReverse = "-fno-defer-typed-holes" - } - , flag { flagName = "-fdefer-out-of-scope-variables" - , flagDescription = - "Convert variable out of scope variables errors into warnings. "++ - "Implied by :ghc-flag:`-fdefer-type-errors`. "++ - "See also :ghc-flag:`-Wdeferred-out-of-scope-variables`." - , flagType = DynamicFlag - , flagReverse = "-fno-defer-out-of-scope-variables" - } - , flag { flagName = "-fhelpful-errors" - , flagDescription = "Make suggestions for mis-spelled names." - , flagType = DynamicFlag - , flagReverse = "-fno-helpful-errors" - } - , flag { flagName = "-freverse-errors" - , flagDescription = - "Display errors in GHC/GHCi sorted by reverse order of "++ - "source code line numbers." - , flagType = DynamicFlag - , flagReverse = "-fno-reverse-errors" - } - , flag { flagName = "-fmax-errors" - , flagDescription = - "Limit the number of errors displayed in GHC/GHCi." - , flagType = DynamicFlag - , flagReverse = "-fno-max-errors" - } - , flag { flagName = "-Wdeprecated-flags" - , flagDescription = - "warn about uses of commandline flags that are deprecated" - , flagType = DynamicFlag - , flagReverse = "-Wno-deprecated-flags" - } - , flag { flagName = "-Wduplicate-constraints" - , flagDescription = - "warn when a constraint appears duplicated in a type signature" - , flagType = DynamicFlag - , flagReverse = "-Wno-duplicate-constraints" - } - , flag { flagName = "-Wduplicate-exports" - , flagDescription = "warn when an entity is exported multiple times" - , flagType = DynamicFlag - , flagReverse = "-Wno-duplicate-exports" - } - , flag { flagName = "-Whi-shadowing" - , flagDescription = - "warn when a ``.hi`` file in the current directory shadows a library" - , flagType = DynamicFlag - , flagReverse = "-Wno-hi-shadowing" - } - , flag { flagName = "-Widentities" - , flagDescription = - "warn about uses of Prelude numeric conversions that are probably "++ - "the identity (and hence could be omitted)" - , flagType = DynamicFlag - , flagReverse = "-Wno-identities" - } - , flag { flagName = "-Wimplicit-prelude" - , flagDescription = "warn when the Prelude is implicitly imported" - , flagType = DynamicFlag - , flagReverse = "-Wno-implicit-prelude" - } - , flag { flagName = "-Wincomplete-patterns" - , flagDescription = "warn when a pattern match could fail" - , flagType = DynamicFlag - , flagReverse = "-Wno-incomplete-patterns" - } - , flag { flagName = "-Wincomplete-uni-patterns" - , flagDescription = - "warn when a pattern match in a lambda expression or "++ - "pattern binding could fail" - , flagType = DynamicFlag - , flagReverse = "-Wno-incomplete-uni-patterns" - } - , flag { flagName = "-fmax-pmcheck-iterations=⟨n⟩" - , flagDescription = - "the iteration limit for the pattern match checker" - , flagType = DynamicFlag - } - , flag { flagName = "-Wincomplete-record-updates" - , flagDescription = "warn when a record update could fail" - , flagType = DynamicFlag - , flagReverse = "-Wno-incomplete-record-updates" - } - , flag { flagName = "-Wmissing-fields" - , flagDescription = "warn when fields of a record are uninitialised" - , flagType = DynamicFlag - , flagReverse = "-Wno-missing-fields" - } - , flag { flagName = "-Wmissing-import-lists" - , flagDescription = - "warn when an import declaration does not explicitly list all the"++ - "names brought into scope" - , flagType = DynamicFlag - , flagReverse = "-fnowarn-missing-import-lists" - } - , flag { flagName = "-Wmissing-methods" - , flagDescription = "warn when class methods are undefined" - , flagType = DynamicFlag - , flagReverse = "-Wno-missing-methods" - } - , flag { flagName = "-Wmissing-signatures" - , flagDescription = "warn about top-level functions without signatures" - , flagType = DynamicFlag - , flagReverse = "-Wno-missing-signatures" - } - , flag { flagName = "-Wmissing-exported-sigs" - , flagDescription = - "*(deprecated)* "++ - "warn about top-level functions without signatures, only if they "++ - "are exported. takes precedence over -Wmissing-signatures" - , flagType = DynamicFlag - , flagReverse = "-Wno-missing-exported-sigs" - } - , flag { flagName = "-Wmissing-exported-signatures" - , flagDescription = - "warn about top-level functions without signatures, only if they "++ - "are exported. takes precedence over -Wmissing-signatures" - , flagType = DynamicFlag - , flagReverse = "-Wno-missing-exported-signatures" - } - , flag { flagName = "-Wmissing-local-sigs" - , flagDescription = - "*(deprecated)* "++ - "warn about polymorphic local bindings without signatures" - , flagType = DynamicFlag - , flagReverse = "-Wno-missing-local-sigs" - } - , flag { flagName = "-Wmissing-local-signatures" - , flagDescription = - "warn about polymorphic local bindings without signatures" - , flagType = DynamicFlag - , flagReverse = "-Wno-missing-local-signatures" - } - , flag { flagName = "-Wmissing-monadfail-instances" - , flagDescription = - "warn when a failable pattern is used in a do-block that does " ++ - "not have a ``MonadFail`` instance." - , flagType = DynamicFlag - , flagReverse = "-Wno-missing-monadfail-instances" - } - , flag { flagName = "-Wsemigroup" - , flagDescription = - "warn when a ``Monoid`` is not ``Semigroup``, and on non-" ++ - "``Semigroup`` definitions of ``(<>)``?" - , flagType = DynamicFlag - , flagReverse = "-Wno-semigroup" - } - , flag { flagName = "-Wmissed-specialisations" - , flagDescription = - "warn when specialisation of an imported, overloaded function fails." - , flagType = DynamicFlag - , flagReverse = "-Wno-missed-specialisations" - } - , flag { flagName = "-Wall-missed-specialisations" - , flagDescription = - "warn when specialisation of any overloaded function fails." - , flagType = DynamicFlag - , flagReverse = "-Wno-all-missed-specialisations" - } - , flag { flagName = "-Wmonomorphism-restriction" - , flagDescription = "warn when the Monomorphism Restriction is applied" - , flagType = DynamicFlag - , flagReverse = "-Wno-monomorphism-restriction" - } - , flag { flagName = "-Wname-shadowing" - , flagDescription = "warn when names are shadowed" - , flagType = DynamicFlag - , flagReverse = "-Wno-name-shadowing" - } - , flag { flagName = "-Wnoncanonical-monad-instances" - , flagDescription = - "warn when ``Applicative`` or ``Monad`` instances have "++ - "noncanonical definitions of ``return``, ``pure``, ``(>>)``, "++ - "or ``(*>)``. "++ - "See flag description in :ref:`options-sanity` for more details." - , flagType = DynamicFlag - , flagReverse = "-Wno-noncanonical-monad-instances" - } - , flag { flagName = "-Wnoncanonical-monadfail-instances" - , flagDescription = - "warn when ``Monad`` or ``MonadFail`` instances have "++ - "noncanonical definitions of ``fail``."++ - "See flag description in :ref:`options-sanity` for more details." - , flagType = DynamicFlag - , flagReverse = "-Wno-noncanonical-monadfail-instances" - } - , flag { flagName = "-Wnoncanonical-monoid-instances" - , flagDescription = - "warn when ``Semigroup`` or ``Monoid`` instances have "++ - "noncanonical definitions of ``(<>)`` or ``mappend``. "++ - "See flag description in :ref:`options-sanity` for more details." - , flagType = DynamicFlag - , flagReverse = "-Wno-noncanonical-monoid-instances" - } - , flag { flagName = "-Worphans" - , flagDescription = - "warn when the module contains :ref:`orphan instance declarations "++ - "or rewrite rules <orphan-modules>`" - , flagType = DynamicFlag - , flagReverse = "-Wno-orphans" - } - , flag { flagName = "-Woverlapping-patterns" - , flagDescription = "warn about overlapping patterns" - , flagType = DynamicFlag - , flagReverse = "-Wno-overlapping-patterns" - } - , flag { flagName = "-Wtabs" - , flagDescription = "warn if there are tabs in the source file" - , flagType = DynamicFlag - , flagReverse = "-Wno-tabs" - } - , flag { flagName = "-Wtype-defaults" - , flagDescription = "warn when defaulting happens" - , flagType = DynamicFlag - , flagReverse = "-Wno-type-defaults" - } - , flag { flagName = "-Wunrecognised-pragmas" - , flagDescription = - "warn about uses of pragmas that GHC doesn't recognise" - , flagType = DynamicFlag - , flagReverse = "-Wno-unrecognised-pragmas" - } - , flag { flagName = "-Wunticked-promoted-constructors" - , flagDescription = "warn if promoted constructors are not ticked" - , flagType = DynamicFlag - , flagReverse = "-Wno-unticked-promoted-constructors" - } - , flag { flagName = "-Wunused-binds" - , flagDescription = - "warn about bindings that are unused. Alias for "++ - ":ghc-flag:`-Wunused-top-binds`, :ghc-flag:`-Wunused-local-binds` and "++ - ":ghc-flag:`-Wunused-pattern-binds`" - , flagType = DynamicFlag - , flagReverse = "-Wno-unused-binds" - } - , flag { flagName = "-Wunused-top-binds" - , flagDescription = "warn about top-level bindings that are unused" - , flagType = DynamicFlag - , flagReverse = "-Wno-unused-top-binds" - } - , flag { flagName = "-Wunused-local-binds" - , flagDescription = "warn about local bindings that are unused" - , flagType = DynamicFlag - , flagReverse = "-Wno-unused-local-binds" - } - , flag { flagName = "-Wunused-pattern-binds" - , flagDescription = "warn about pattern match bindings that are unused" - , flagType = DynamicFlag - , flagReverse = "-Wno-unused-pattern-binds" - } - , flag { flagName = "-Wunused-imports" - , flagDescription = "warn about unnecessary imports" - , flagType = DynamicFlag - , flagReverse = "-Wno-unused-imports" - } - , flag { flagName = "-Wunused-matches" - , flagDescription = "warn about variables in patterns that aren't used" - , flagType = DynamicFlag - , flagReverse = "-Wno-unused-matches" - } - , flag { flagName = "-Wunused-foralls" - , flagDescription = "warn about type variables in user-written "++ - "``forall``\\s that are unused" - , flagType = DynamicFlag - , flagReverse = "-Wno-unused-foralls" - } - , flag { flagName = "-Wunused-type-variables" - , flagDescription = "warn about variables in type family or data "++ - "family instances that are unused" - , flagType = DynamicFlag - , flagReverse = "-Wno-unused-type-variables" - } - , flag { flagName = "-Wunused-do-bind" - , flagDescription = - "warn about do bindings that appear to throw away values of types "++ - "other than ``()``" - , flagType = DynamicFlag - , flagReverse = "-Wno-unused-do-bind" - } - , flag { flagName = "-Wwrong-do-bind" - , flagDescription = - "warn about do bindings that appear to throw away monadic values "++ - "that you should have bound instead" - , flagType = DynamicFlag - , flagReverse = "-Wno-wrong-do-bind" - } - , flag { flagName = "-Wunsafe" - , flagDescription = - "warn if the module being compiled is regarded to be unsafe. "++ - "Should be used to check the safety status of modules when using "++ - "safe inference. Works on all module types, even those using "++ - "explicit :ref:`Safe Haskell <safe-haskell>` modes (such as "++ - ":ghc-flag:`-XTrustworthy`) and so can be used to have the compiler check "++ - "any assumptions made." - , flagType = DynamicFlag - , flagReverse = "-Wno-unsafe" - } - , flag { flagName = "-Wsafe" - , flagDescription = - "warn if the module being compiled is regarded to be safe. Should "++ - "be used to check the safety status of modules when using safe "++ - "inference. Works on all module types, even those using explicit "++ - ":ref:`Safe Haskell <safe-haskell>` modes (such as "++ - ":ghc-flag:`-XTrustworthy`) and so can be used to have the compiler check "++ - "any assumptions made." - , flagType = DynamicFlag - , flagReverse = "-Wno-safe" - } - , flag { flagName = "-Wtrustworthy-safe" - , flagDescription = - "warn if the module being compiled is marked as "++ - ":ghc-flag:`-XTrustworthy` but it could instead be marked as "++ - ":ghc-flag:`-XSafe`, a more informative bound. Can be used to detect"++ - "once a Safe Haskell bound can be improved as dependencies are updated." - , flagType = DynamicFlag - , flagReverse = "-Wno-safe" - } - , flag { flagName = "-Wwarnings-deprecations" - , flagDescription = - "warn about uses of functions & types that have warnings or "++ - "deprecated pragmas" - , flagType = DynamicFlag - , flagReverse = "-Wno-warnings-deprecations" - } - , flag { flagName = "-Wdeprecations" - , flagDescription = - "warn about uses of functions & types that have warnings or "++ - "deprecated pragmas. Alias for :ghc-flag:`-Wwarnings-deprecations`" - , flagType = DynamicFlag - , flagReverse = "-Wno-deprecations" - } - , flag { flagName = "-Wamp" - , flagDescription = - "*(deprecated)* warn on definitions conflicting with the "++ - "Applicative-Monad Proposal (AMP)" - , flagType = DynamicFlag - , flagReverse = "-Wno-amp" - } - , flag { flagName = "-Wredundant-constraints" - , flagDescription = - "Have the compiler warn about redundant constraints in type"++ - "signatures." - , flagType = DynamicFlag - , flagReverse = "-Wno-redundant-constraints" - } - , flag { flagName = "-Wdeferred-type-errors" - , flagDescription = - "Report warnings when :ref:`deferred type errors "++ - "<defer-type-errors>` are enabled. This option is enabled by "++ - "default. See :ghc-flag:`-fdefer-type-errors`." - , flagType = DynamicFlag - , flagReverse = "-Wno-deferred-type-errors" - } - , flag { flagName = "-Wtyped-holes" - , flagDescription = - "Report warnings when :ref:`typed hole <typed-holes>` errors are "++ - ":ref:`deferred until runtime <defer-type-errors>`. See "++ - ":ghc-flag:`-fdefer-typed-holes`." - , flagType = DynamicFlag - , flagReverse = "-Wno-typed-holes" - } - , flag { flagName = "-Wdeferred-out-of-scope-variables" - , flagDescription = - "Report warnings when variable out-of-scope errors are "++ - ":ref:`deferred until runtime. "++ - "See :ghc-flag:`-fdefer-out-of-scope-variables`." - , flagType = DynamicFlag - , flagReverse = "-Wno-deferred-out-of-scope-variables" - } - , flag { flagName = "-Wpartial-type-signatures" - , flagDescription = - "warn about holes in partial type signatures when "++ - ":ghc-flag:`-XPartialTypeSignatures` is enabled. Not applicable when "++ - ":ghc-flag:`-XPartialTypesignatures` is not enabled, in which case "++ - "errors are generated for such holes. See "++ - ":ref:`partial-type-signatures`." - , flagType = DynamicFlag - , flagReverse = "-Wno-partial-type-signatures" - } - , flag { flagName = "-Wderiving-typeable" - , flagDescription = - "warn when encountering a request to derive an instance of class "++ - "``Typeable``. As of GHC 7.10, such declarations are unnecessary "++ - "and are ignored by the compiler because GHC has a custom solver "++ - "for discharging this type of constraint." - , flagType = DynamicFlag - , flagReverse = "-Wno-deriving-typeable" - } - , flag { flagName = "-Wmissing-home-modules" - , flagDescription = - "warn when encountering a home module imported, but not listed "++ - "on the command line. Useful for cabal to ensure GHC won't pick "++ - "up modules, not listed neither in ``exposed-modules``, nor in "++ - "``other-modules``." - , flagType = DynamicFlag - , flagReverse = "-Wno-missing-home-modules" - } - ] diff --git a/utils/mkUserGuidePart/Table.hs b/utils/mkUserGuidePart/Table.hs deleted file mode 100644 index eeff8205cb..0000000000 --- a/utils/mkUserGuidePart/Table.hs +++ /dev/null @@ -1,75 +0,0 @@ -module Table where - -import Data.Char -import Data.List -import Data.Maybe (isJust, fromMaybe) -import qualified DList - -type Row = [String] - -type ColWidth = Int - -type WrappedString = [String] - --- | Wrap a string to lines of at most the given length on whitespace --- if possible. -wrapAt :: Int -> String -> WrappedString -wrapAt width = wrapLine - where - wrapLine :: String -> WrappedString - wrapLine s = - go width mempty (take width s : wrapLine (drop width s)) s - - go :: Int -- ^ remaining width - -> DList.DList Char -- ^ accumulator - -> WrappedString -- ^ last good wrapping - -> String -- ^ remaining string - -> WrappedString - go 0 _ back _ = back - go n accum _ (c:rest) - | breakable c = go (n-1) accum' - (DList.toList accum' : wrapLine rest) rest - where accum' = accum `DList.snoc` c - go n accum back (c:rest) = go (n-1) (accum `DList.snoc` c) back rest - go _ accum _ [] = [DList.toList accum] - - breakable = isSpace - -transpose' :: [[a]] -> [[Maybe a]] -transpose' = goRow - where - peel :: [a] -> (Maybe a, [a]) - peel (x:xs) = (Just x, xs) - peel [] = (Nothing, []) - - goRow xs = - case unzip $ map peel xs of - (xs', ys) - | any isJust xs' -> xs' : goRow ys - | otherwise -> [] - -table :: [ColWidth] -> Row -> [Row] -> String -table widths hdr rows = unlines $ - [rule '-'] ++ - [formatRow hdr] ++ - [rule '='] ++ - intersperse (rule '-') (map formatRow rows) ++ - [rule '-'] - where - formatRow :: Row -> String - formatRow cols = - intercalate "\n" - $ map (rawRow . map (fromMaybe "")) - $ transpose' - $ zipWith wrapAt (map (subtract 4) widths) cols - - rawRow :: Row -> String - rawRow cols = "| " ++ intercalate " | " (zipWith padTo widths cols) ++ " |" - padTo width content = take width $ content ++ repeat ' ' - - rule :: Char -> String - rule lineChar = - ['+',lineChar] - ++intercalate [lineChar,'+',lineChar] - (map (\n -> replicate n lineChar) widths) - ++[lineChar,'+'] diff --git a/utils/mkUserGuidePart/Types.hs b/utils/mkUserGuidePart/Types.hs deleted file mode 100644 index 340672e3b6..0000000000 --- a/utils/mkUserGuidePart/Types.hs +++ /dev/null @@ -1,18 +0,0 @@ -module Types where - -data FlagType = DynamicFlag - -- ^ Dynamic flag - | DynamicSettableFlag - -- ^ Dynamic flag on which @:set@ can be used in GHCi - | ModeFlag - -- ^ A mode of execution (e.g. @--mode@) - -data Flag = Flag { flagName :: String - , flagDescription :: String - , flagType :: FlagType - , flagReverse :: String - , flagSince :: String - } - -flag :: Flag -flag = Flag "" "" DynamicFlag "" "" diff --git a/utils/mkUserGuidePart/ghc.mk b/utils/mkUserGuidePart/ghc.mk deleted file mode 100644 index 069634b96d..0000000000 --- a/utils/mkUserGuidePart/ghc.mk +++ /dev/null @@ -1,93 +0,0 @@ -# ----------------------------------------------------------------------------- -# -# (c) 2009 The University of Glasgow -# -# This file is part of the GHC build system. -# -# To understand how the build system works and how to modify it, see -# http://ghc.haskell.org/trac/ghc/wiki/Building/Architecture -# http://ghc.haskell.org/trac/ghc/wiki/Building/Modifying -# -# ----------------------------------------------------------------------------- - -utils/mkUserGuidePart_GENERATED_FLAGS_SETS := \ - codegen \ - compiler-debugging \ - cpp \ - finding-imports \ - interactive \ - interface-files \ - keeping-intermediates \ - language \ - linking \ - misc \ - modes \ - optimization \ - optimization-levels \ - packages \ - phase-programs \ - phases \ - phase-specific \ - platform-specific \ - plugin \ - profiling \ - program-coverage \ - recompilation-checking \ - redirecting-output \ - temporary-files \ - verbosity \ - warnings - -# See Note [Blessed make target file] -utils/mkUserGuidePart_GENERATED_RST_SOURCES_BLESSED_FILE := \ - docs/users_guide/what_glasgow_exts_does.gen.rst - -utils/mkUserGuidePart_GENERATED_RST_SOURCES_OTHER_FILES := \ - $(addprefix docs/users_guide/flags-,$(addsuffix .gen.rst,$(utils/mkUserGuidePart_GENERATED_FLAGS_SETS))) \ - docs/users_guide/all-flags.gen.rst - -utils/mkUserGuidePart_GENERATED_RST_SOURCES := \ - $(utils/mkUserGuidePart_GENERATED_RST_SOURCES_BLESSED_FILE) \ - $(utils/mkUserGuidePart_GENERATED_RST_SOURCES_OTHER_FILES) - -utils/mkUserGuidePart_USES_CABAL = YES -utils/mkUserGuidePart_PACKAGE = mkUserGuidePart -utils/mkUserGuidePart_dist_PROGNAME = mkUserGuidePart -utils/mkUserGuidePart_dist_INSTALL_INPLACE = YES - -$(eval $(call build-prog,utils/mkUserGuidePart,dist,2)) -$(eval $(call clean-target,utils/mkUserGuidePart,gen,$(utils/mkUserGuidePart_GENERATED_RST_SOURCES))) - -$(utils/mkUserGuidePart_GENERATED_RST_SOURCES_OTHER_FILES) : - -$(utils/mkUserGuidePart_GENERATED_RST_SOURCES_BLESSED_FILE) : $(utils/mkUserGuidePart_GENERATED_RST_SOURCES_OTHER_FILES) $(mkUserGuidePart_INPLACE) - $(mkUserGuidePart_INPLACE) - $(TOUCH_CMD) $@ - -all_utils/mkUserGuidePart: $(mkUserGuidePart_INPLACE) - -# Note [Blessed make target file] -# -# make cannot express nicely a single build rule -# with multiple targets: -# -# > all: a b -# > a b: -# > touch a b -# -# This code will run 'touch' rule twice when parallel -# make is used: -# > $ make -j -# > touch a b -# > touch a b -# -# But there is a workaround for it: -# We pick a single file of a group and depend on it -# as an ultimate target. We also need to make sure -# that file has latest timestamp in the group: -# -# > all: a b -# > b: -# > a: b -# > touch a b -# > touch $@ diff --git a/utils/mkUserGuidePart/mkUserGuidePart.cabal.in b/utils/mkUserGuidePart/mkUserGuidePart.cabal.in deleted file mode 100644 index e07033cd02..0000000000 --- a/utils/mkUserGuidePart/mkUserGuidePart.cabal.in +++ /dev/null @@ -1,55 +0,0 @@ -Name: mkUserGuidePart -Version: @ProjectVersionMunged@ -Copyright: XXX -License: BSD3 --- XXX License-File: LICENSE --- XXX Author: --- XXX Maintainer: -Synopsis: Generate various portions of GHC's documentation -Description: - This tool is responsible for producing ReStructuredText sources which - are included in GHC's user's guide and manpage. -build-type: Simple -cabal-version: >=1.10 - -Executable mkUserGuidePart - Default-Language: Haskell2010 - Main-Is: Main.hs - Other-Modules: - Types - DList - Table - Options - Options.CodeGen - Options.CompilerDebugging - Options.Cpp - Options.FindingImports - Options.Interactive - Options.InterfaceFiles - Options.KeepingIntermediates - Options.Language - Options.Linking - Options.Misc - Options.Modes - Options.OptimizationLevels - Options.Optimizations - Options.Packages - Options.PhasePrograms - Options.Phases - Options.PhaseSpecific - Options.PlatformSpecific - Options.Plugin - Options.Profiling - Options.ProgramCoverage - Options.RecompilationChecking - Options.RedirectingOutput - Options.TemporaryFiles - Options.Verbosity - Options.Warnings - Build-Depends: base >= 3 && < 5, - -- mkUserGuidePart uses the compiler's DynFlags to determine - -- a few options-related properties of the compiler. - -- Consequently we should make sure we are building against - -- the right compiler. - ghc == @ProjectVersionMunged@ - diff --git a/utils/mkdirhier/ghc.mk b/utils/mkdirhier/ghc.mk index 55803f0007..2e3a301c9a 100644 --- a/utils/mkdirhier/ghc.mk +++ b/utils/mkdirhier/ghc.mk @@ -14,7 +14,7 @@ $(MKDIRHIER) : utils/mkdirhier/mkdirhier.sh mkdir -p $(INPLACE_BIN) mkdir -p $(INPLACE_LIB) $(call removeFiles,$@) - echo '#!$(SHELL)' >> $@ + echo '#!/bin/sh' >> $@ cat utils/mkdirhier/mkdirhier.sh >> $@ $(EXECUTABLE_FILE) $@ diff --git a/utils/runghc/Main.hs b/utils/runghc/Main.hs index b5d4a4a9ca..dec53eefb0 100644 --- a/utils/runghc/Main.hs +++ b/utils/runghc/Main.hs @@ -19,6 +19,7 @@ module Main (main) where import Control.Exception +import Data.Semigroup as Semi import System.Directory import System.Environment import System.Exit @@ -77,14 +78,17 @@ data RunGhcFlags = RunGhcFlags (Maybe FilePath) -- GHC location | Help -- Print help text | ShowVersion -- Print version info +instance Semi.Semigroup RunGhcFlags where + Help <> _ = Help + _ <> Help = Help + ShowVersion <> _ = ShowVersion + _ <> ShowVersion = ShowVersion + RunGhcFlags _ <> right@(RunGhcFlags (Just _)) = right + left@(RunGhcFlags _) <> RunGhcFlags Nothing = left + instance Monoid RunGhcFlags where mempty = RunGhcFlags Nothing - Help `mappend` _ = Help - _ `mappend` Help = Help - ShowVersion `mappend` _ = ShowVersion - _ `mappend` ShowVersion = ShowVersion - RunGhcFlags _ `mappend` right@(RunGhcFlags (Just _)) = right - left@(RunGhcFlags _) `mappend` RunGhcFlags Nothing = left + mappend = (<>) parseRunGhcFlags :: [String] -> (RunGhcFlags, [String]) parseRunGhcFlags = f mempty diff --git a/utils/touchy/touchy.cabal b/utils/touchy/touchy.cabal new file mode 100644 index 0000000000..377051e28b --- /dev/null +++ b/utils/touchy/touchy.cabal @@ -0,0 +1,16 @@ +cabal-version: 2.1 +Name: touchy +Version: 0.1 +Copyright: XXX +License: BSD-3-Clause +Author: XXX +Maintainer: XXX +Synopsis: @touch@ for windows +Description: XXX +Category: Development +build-type: Simple + +Executable unlit + Default-Language: Haskell2010 + Main-Is: touchy.c + C-Sources: touchy.c diff --git a/utils/unlit/ghc.mk b/utils/unlit/ghc.mk index 8911f4e856..0560aa57b8 100644 --- a/utils/unlit/ghc.mk +++ b/utils/unlit/ghc.mk @@ -11,7 +11,7 @@ # ----------------------------------------------------------------------------- # built by ghc-stage0 -utils/unlit_dist_C_SRCS = unlit.c +utils/unlit_dist_C_SRCS = unlit.c fs.c utils/unlit_dist_PROGNAME = unlit utils/unlit_dist_TOPDIR = YES utils/unlit_dist_INSTALL_INPLACE = YES diff --git a/utils/unlit/unlit.c b/utils/unlit/unlit.c index 4eb91d71be..97f853b268 100644 --- a/utils/unlit/unlit.c +++ b/utils/unlit/unlit.c @@ -7,7 +7,7 @@ * column on each line. It is hoped that this style of programming will * encourage the writing of accurate and clearly documented programs * in which the writer may include motivating arguments, examples - * and explanations. + * and explanations. * * Unlit is a filter that can be used to strip all of the comment lines * out of a literate script file. The command format for unlit is: @@ -40,6 +40,7 @@ * And \begin{pseudocode} ... \end{pseudocode}. -- LA */ +#include "fs.h" #include <string.h> #include <stdio.h> #include <stdlib.h> @@ -115,7 +116,7 @@ static void myputc(char c, FILE *ostream) { if (putc(c,ostream) == EOF) { writeerror(); - } + } } #define TABPOS 8 @@ -179,7 +180,7 @@ static line readline(FILE *istream, FILE *ostream) { if (c==EOF) return ENDFILE; - + if ( c == '#' ) { if ( ignore_shebang ) { c1 = egetc(istream); @@ -335,10 +336,10 @@ int main(int argc,char **argv) else if (strcmp(*argv,"-h")==0) { if (argc > 1) { argc--; argv++; - if (prefix_str) + if (prefix_str) free(prefix_str); prefix_str = (char*)malloc(sizeof(char)*(1+strlen(*argv))); - if (prefix_str) + if (prefix_str) strcpy(prefix_str, *argv); } } else if (strcmp(*argv,"-#")==0) @@ -362,16 +363,16 @@ int main(int argc,char **argv) file = "stdin"; } else - if ((istream=fopen(argv[0], "r")) == NULL) { + if ((istream=__hs_fopen(argv[0], "r")) == NULL) { fprintf(stderr, CANNOTOPEN, argv[0]); exit(1); } ofilename=argv[1]; - if (strcmp(argv[1], "-")==0) - ostream = stdout; + if (strcmp(argv[1], "-")==0) + ostream = stdout; else - if ((ostream=fopen(argv[1], "w")) == NULL) { + if ((ostream=__hs_fopen(argv[1], "w")) == NULL) { fprintf(stderr, CANNOTOPEN, argv[1]); exit(1); } diff --git a/utils/unlit/unlit.cabal b/utils/unlit/unlit.cabal new file mode 100644 index 0000000000..622a55934d --- /dev/null +++ b/utils/unlit/unlit.cabal @@ -0,0 +1,17 @@ +cabal-version: 2.1 +Name: unlit +Version: 0.1 +Copyright: XXX +License: BSD-3-Clause +Author: XXX +Maintainer: XXX +Synopsis: Literate program filter +Description: XXX +Category: Development +build-type: Simple + +Executable unlit + Default-Language: Haskell2010 + Main-Is: unlit.c + C-Sources: unlit.c, fs.c + Includes: fs.h |