-        primOpIsWorkFree, primOpIsCheap, primOpFixity, primOpDocs, primOpDeprecations,

-primOpDocs :: [(FastString, String)]

-ghcPrimDeclDocs = emptyDocs { docs_decls = listToUniqMap $ mapMaybe findName primOpDocs }

-    findName (nameStr, doc)

-      | Just name <- lookupFsEnv ghcPrimNames nameStr

-      = Just (name, [WithHsDocIdentifiers (mkGeneratedHsDocString doc) []])

-      | otherwise = Nothing

-For haddocks of GHC.Prim we generate a dummy haskell file (gen_hs_source) that

-contains the type signatures and the comments (but no implementations)

-specifically for consumption by haddock.

-

-GHCi's :doc command reads directly from ModIface's though, and GHC.Prim has a

-wired-in iface that has nothing to do with the above haskell file. The code

-below converts primops.txt into an intermediate form that would later be turned

-into a proper DeclDocMap.

-

-We output the docs as a list of pairs (name, docs). We use stringy names here

-because mapping names to "Name"s is difficult for things like primtypes and

-pseudoops.

---   the following three types of files.

---   2. The dummy Prim.hs file, which is used for Haddock and

---      contains descriptions taken from primops.txt.pp.

---      All definitions are replaced by placeholders.

---      See Note [GHC.Prim Docs] in GHC.Builtin.Utils.

---

---   3. The module PrimopWrappers.hs, which wraps every call for GHCi;

-    return [path -/- "GHC/Internal/Prim.hs", path -/- "GHC/Internal/PrimopWrappers.hs"]

-            root -/- "**" -/- dir -/- "GHC/Internal/Prim.hs" %> genPrimopCode context

-    , output "//Prim.hs"                           ? arg "--make-haskell-source"

-        GHC.Internal.Prim

-                      "--make-haskell-source"  -> "as;dg"

-                      "--make-haskell-source"

-                         -> putStr (gen_hs_source p_o_specs)

-

-       "--make-haskell-source",

-gen_hs_source :: Info -> String

-gen_hs_source (Info defaults entries) =

-       "{-\n"

-    ++ "This is a generated file (generated by genprimopcode).\n"

-    ++ "It is not code to actually be used. Its only purpose is to be\n"

-    ++ "consumed by haddock.\n"

-    ++ "-}\n"

-    ++ "\n"

-        ++ (replicate 77 '-' ++ "\n") -- For 80-col cleanliness

-        ++ "-- |\n"

-        ++ "-- Module      :  GHC.Internal.Prim\n"

-        ++ "-- \n"

-        ++ "-- Maintainer  :  ghc-devs@haskell.org\n"

-        ++ "-- Stability   :  internal\n"

-        ++ "-- Portability :  non-portable (GHC extensions)\n"

-        ++ "--\n"

-        ++ "-- GHC\'s primitive types and operations.\n"

-        ++ "-- Use GHC.Exts from the base package instead of importing this\n"

-        ++ "-- module directly.\n"

-        ++ "--\n"

-        ++ (replicate 77 '-' ++ "\n") -- For 80-col cleanliness

-        ++ "{-# LANGUAGE Unsafe #-}\n"

-        ++ "{-# LANGUAGE MagicHash #-}\n"

-        ++ "{-# LANGUAGE MultiParamTypeClasses #-}\n"

-        ++ "{-# LANGUAGE NoImplicitPrelude #-}\n"

-        ++ "{-# LANGUAGE UnboxedTuples #-}\n"

-        ++ "{-# LANGUAGE NegativeLiterals #-}\n"

-

-        ++ "{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}\n"

-                -- We generate a binding for coerce, like

-                --   coerce :: Coercible a b => a -> b

-                --   coerce = let x = x in x

-                -- and we don't want a complaint that the constraint is redundant

-                -- Remember, this silly file is only for Haddock's consumption

-

-        ++ "{-# OPTIONS_HADDOCK print-explicit-runtime-reps #-}\n"

-        ++ "module GHC.Internal.Prim (\n"

-        ++ unlines (map (("        " ++) . hdr) entries')

-        ++ ") where\n"

-    ++ "\n"

-    ++ "{-\n"

-        ++ unlines (map opt defaults)

-    ++ "-}\n"

-    -- this import introduces a loop between GHC.Internal.Types and

-    -- GHC.Internal.Prim.

-    -- ++ "import GHC.Internal.Types (Coercible)\n"

-

-    ++ "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

-                     -- 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

-                     -- coming from GHC.Iface.Load.homeModError

-                     -- I'm not sure precisely why; but I *am* sure that we don't need

-                     -- any type-class defaulting; and it's clearly wrong to need

-                     -- the base package when haddocking ghc-prim

-

-       -- Now the main payload

-    ++ "\n" ++ unlines (concatMap ent entries') ++ "\n\n\n"

-

-     where entries' = concatMap desugarVectorSpec entries

-

-           opt (OptionFalse n)    = n ++ " = False"

-           opt (OptionTrue n)     = n ++ " = True"

-           opt (OptionString n v) = n ++ " = { " ++ v ++ "}"

-           opt (OptionInteger n v) = n ++ " = " ++ show v

-           opt (OptionVector _)    = ""

-           opt (OptionFixity mf) = "fixity = " ++ show mf

-           opt (OptionEffect eff) = "effect = " ++ show eff

-           opt (OptionDefinedBits bc) = "defined_bits = " ++ show bc

-           opt (OptionCanFailWarnFlag wf) = "can_fail_warning = " ++ show wf

-

-           hdr s@(Section {})                                    = sec s

-           hdr (PrimOpSpec { name = n })                         = wrapOp n ++ ","

-           hdr (PrimVecOpSpec { name = n })                      = wrapOp n ++ ","

-           hdr (PseudoOpSpec { name = n })                       = wrapOp n ++ ","

-           hdr (PrimTypeSpec { ty = TyApp (TyCon n) _ })         = wrapOp n ++ ","

-           hdr (PrimTypeSpec {})                                 = error $ "Illegal type spec"

-           hdr (PrimVecTypeSpec { ty = TyApp (VecTyCon n _) _ }) = wrapOp n ++ ","

-           hdr (PrimVecTypeSpec {})                              = error $ "Illegal type spec"

-

-           sec s = "\n{- * " ++ title s ++ "-}\n{-|" ++ desc s ++ "-}"

-

-

-           ent   (Section {})         = []

-           ent o@(PrimOpSpec {})      = spec o

-           ent o@(PrimVecOpSpec {})   = spec o

-           ent o@(PrimTypeSpec {})    = spec o

-           ent o@(PrimVecTypeSpec {}) = spec o

-           ent o@(PseudoOpSpec {})    = spec o

-

-           spec o = ([ "" ] ++) . concat $

-             -- Doc comments

-             [ case desc o ++ extra (opts o) of

-                 "" -> []

-                 cmmt -> lines ("{-|" ++ cmmt ++ "-}")

-

-             -- Deprecations

-             , [ d | Just n <- [getName o], d <- prim_deprecated (opts o) n ]

-

-             -- Fixity

-             , [ f | Just n <- [getName o], f <- prim_fixity (opts o) n ]

-

-             -- Declarations (see Note [Placeholder declarations])

-             , case o of

-                 PrimOpSpec { name = n, ty = t }    -> prim_func n t

-                 PrimVecOpSpec { name = n, ty = t } -> prim_func n t

-                 PseudoOpSpec { name = n, ty = t }  -> prim_func n t

-                 PrimTypeSpec { ty = t }    -> prim_data t

-                 PrimVecTypeSpec { ty = t } -> prim_data t

-                 Section { } -> error "Section is not an entity"

-             ]

-

-           extra options = case can_fail options of

-             [m] -> "\n\n__/Warning:/__ this " ++ m ++ "."

-             _ -> ""

-

-           can_fail options

-             = [ "can fail with an unchecked exception"

-               | Just (OptionEffect eff) <- [lookup_attrib "effect" options]

-               , Just (OptionCanFailWarnFlag wflag) <- [lookup_attrib "can_fail_warning" options]

-               , wflag /= DoNotWarnCanFail

-               , wflag == YesWarnCanFail || eff == CanFail ]

-

-           prim_deprecated options n

-              = [ "{-# DEPRECATED " ++ wrapOp n ++ " \"" ++ msg ++ "\" #-}"

-                | Just (OptionString _ msg)

-                    <- [lookup_attrib "deprecated_msg" options] ]

-

-           prim_fixity options n

-              = [ pprFixityDir d ++ " " ++ show i ++ " " ++ asInfix n

-                | OptionFixity (Just (Fixity i d)) <- options ]

-

-           prim_func n t = [ wrapOp n ++ " :: " ++ pprTy t,

-                             wrapOp n ++ " = " ++ funcRhs n ]

-

-           funcRhs "tagToEnum#" = "let x = x in x"

-           funcRhs nm           = wrapOp nm

-              -- Special case for tagToEnum#: see Note [Placeholder declarations]

-

-           prim_data t = [ "data " ++ pprTy t ]

-

-{- Note [Placeholder declarations]

-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

-We are generating fake declarations for things in GHC.Internal.Prim, just to

-keep GHC's renamer and typechecker happy enough for what Haddock

-needs.  Our main plan is to say

-        foo :: <type>

-        foo = foo

-

-That works for all the primitive functions except tagToEnum#.

-If we generate the binding

-        tagToEnum# = tagToEnum#

-GHC will complain about "tagToEnum# must appear applied to one argument".

-We could hack GHC to silence this complaint when compiling GHC.Internal.Prim,

-but it seems easier to generate

-        tagToEnum# = let x = x in x

-We don't do this for *all* bindings because for ones with an unboxed

-RHS we would get other complaints (e.g.can't unify "*" with "#").

--}

-

--- | Turn an identifier or operator into its infix form

-asInfix :: String -> String

-asInfix nm | isAlpha (head nm) = "`" ++ nm ++ "`"

-           | otherwise         = nm

-

-  = "primOpDocs =\n  [ " ++ intercalate "\n  , " (catMaybes $ map mkDoc $ concatMap desugarVectorSpec entries) ++ "\n  ]\n"

-      mkDoc po | Just poName <- getName po

-               , not $ null $ desc po = Just $ "(fsLit " ++ show poName ++ "," ++ show (desc po) ++ ")"

-               | otherwise = Nothing