diff options
Diffstat (limited to 'utils/genprimopcode/Main.hs')
| -rw-r--r-- | utils/genprimopcode/Main.hs | 49 |
1 files changed, 37 insertions, 12 deletions
diff --git a/utils/genprimopcode/Main.hs b/utils/genprimopcode/Main.hs index 803323fbc0..d8d555cdf2 100644 --- a/utils/genprimopcode/Main.hs +++ b/utils/genprimopcode/Main.hs @@ -305,20 +305,13 @@ gen_hs_source (Info defaults entries) = ++ (unlines $ map ("-- " ++ ) $ lines $ unlatex $ escape $ "|" ++ desc s) ++ "\n" spec o = comm : decls - where decls = case o of + where decls = case o of -- See Note [Placeholder declarations] PrimOpSpec { name = n, ty = t, opts = options } -> - [ pprFixity fixity n | OptionFixity (Just fixity) <- options ] - ++ - [ wrapOp n ++ " :: " ++ pprTy t, - wrapOp n ++ " = let x = x in x" ] + prim_fixity n options ++ prim_decl n t PrimVecOpSpec { name = n, ty = t, opts = options } -> - [ pprFixity fixity n | OptionFixity (Just fixity) <- options ] - ++ - [ wrapOp n ++ " :: " ++ pprTy t, - wrapOp n ++ " = let x = x in x" ] + prim_fixity n options ++ prim_decl n t PseudoOpSpec { name = n, ty = t } -> - [ wrapOp n ++ " :: " ++ pprTy t, - wrapOp n ++ " = let x = x in x" ] + prim_decl n t PrimTypeSpec { ty = t } -> [ "data " ++ pprTy t ] PrimVecTypeSpec { ty = t } -> @@ -329,10 +322,21 @@ gen_hs_source (Info defaults entries) = [] -> "" d -> "\n" ++ (unlines $ map ("-- " ++ ) $ lines $ unlatex $ escape $ "|" ++ d) + prim_fixity n options = [ pprFixity fixity n | OptionFixity (Just fixity) <- options ] + + prim_decl n t = [ wrapOp n ++ " :: " ++ pprTy t, + wrapOp n ++ " = " ++ wrapOpRhs n ] + wrapOp nm | isAlpha (head nm) = nm | otherwise = "(" ++ nm ++ ")" + wrapTy nm | isAlpha (head nm) = nm | otherwise = "(" ++ nm ++ ")" + + wrapOpRhs "tagToEnum#" = "let x = x in x" + wrapOpRhs nm = wrapOp nm + -- Special case for tagToEnum#: see Note [Placeholder declarations] + unlatex s = case s of '\\':'t':'e':'x':'t':'t':'t':'{':cs -> markup "@" "@" cs '{':'\\':'t':'t':cs -> markup "@" "@" cs @@ -349,6 +353,27 @@ gen_hs_source (Info defaults entries) = pprFixity (Fixity i d) n = pprFixityDir d ++ " " ++ show i ++ " " ++ n +{- Note [Placeholder declarations] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +We are generating fake declarations for things in GHC.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 +We have to silence GHC's complaints about unboxed-top-level declarations +with an ad-hoc fix in TcBinds: see Note [Compiling GHC.Prim] in TcBinds. + +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.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 "#"). +-} + pprTy :: Ty -> String pprTy = pty where @@ -813,7 +838,7 @@ ppType (TyApp (TyCon "TVar#") [x,y]) = "mkTVarPrimTy " ++ ppType x ppType (TyApp (VecTyCon _ pptc) []) = pptc -ppType (TyUTup ts) = "(mkTupleTy UnboxedTuple " +ppType (TyUTup ts) = "(mkTupleTy Unboxed " ++ listify (map ppType ts) ++ ")" ppType (TyF s d) = "(mkFunTy (" ++ ppType s ++ ") (" ++ ppType d ++ "))" |