Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

fsep is slow even when we don't benefit from it, relax its use? #89

Draft
wants to merge 1 commit into
base: master
Choose a base branch
from
Draft

fsep is slow even when we don't benefit from it, relax its use? #89

Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
40 changes: 24 additions & 16 deletions src/Text/LLVM/PP.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -45,6 +45,11 @@ data Config = Config { cfgLoadImplicitType :: Bool
-- instruction is implied.

, cfgUseDILocation :: Bool

, cfgCommaSep :: [Doc] -> Doc
-- ^ Replaces certain uses of fillSep with hsep to layout
-- faster if the page is known to have unbounded width.

}

withConfig :: Config -> (LLVM => a) -> a
Expand All @@ -60,14 +65,17 @@ ppLLVM35 = ppLLVM36
ppLLVM36 = withConfig Config { cfgLoadImplicitType = True
, cfgGEPImplicitType = True
, cfgUseDILocation = False
, cfgCommaSep = hsep
}
ppLLVM37 = withConfig Config { cfgLoadImplicitType = False
, cfgGEPImplicitType = False
, cfgUseDILocation = True
, cfgCommaSep = hsep
}
ppLLVM38 = withConfig Config { cfgLoadImplicitType = False
, cfgGEPImplicitType = False
, cfgUseDILocation = True
, cfgCommaSep = hsep
}

checkConfig :: LLVM => (Config -> Bool) -> Bool
Expand Down Expand Up @@ -100,7 +108,7 @@ ppSourceName (Just sn) = "source_filename" <+> char '=' <+> doubleQuotes (text s

-- Metadata --------------------------------------------------------------------

ppNamedMd :: NamedMd -> Doc
ppNamedMd :: LLVM => NamedMd -> Doc
ppNamedMd nm =
sep [ ppMetadata (text (nmName nm)) <+> char '='
, ppMetadata (braces (commas (map (ppMetadata . int) (nmValues nm)))) ]
Expand Down Expand Up @@ -226,7 +234,7 @@ ppFloatType Fp128 = "fp128"
ppFloatType X86_fp80 = "x86_fp80"
ppFloatType PPC_fp128 = "ppc_fp128"

ppType :: Type -> Doc
ppType :: LLVM => Type -> Doc
ppType (PrimType pt) = ppPrimType pt
ppType (Alias i) = ppIdent i
ppType (Array len ty) = brackets (integral len <+> char 'x' <+> ppType ty)
Expand All @@ -237,7 +245,7 @@ ppType (FunTy r as va) = ppType r <> ppArgList va (map ppType as)
ppType (Vector len pt) = angles (integral len <+> char 'x' <+> ppType pt)
ppType Opaque = "opaque"

ppTypeDecl :: TypeDecl -> Doc
ppTypeDecl :: LLVM => TypeDecl -> Doc
ppTypeDecl td = ppIdent (typeName td) <+> char '='
<+> "type" <+> ppType (typeValue td)

Expand Down Expand Up @@ -278,7 +286,7 @@ ppStructGlobalAttrs ga
constant | gaConstant ga = "constant"
| otherwise = "global"

ppDeclare :: Declare -> Doc
ppDeclare :: LLVM => Declare -> Doc
ppDeclare d = "declare"
<+> ppMaybe ppLinkage (decLinkage d)
<+> ppMaybe ppVisibility (decVisibility d)
Expand Down Expand Up @@ -421,7 +429,7 @@ ppGC = doubleQuotes . text . getGC

-- Expressions -----------------------------------------------------------------

ppTyped :: (a -> Doc) -> Typed a -> Doc
ppTyped :: LLVM => (a -> Doc) -> Typed a -> Doc
ppTyped fmt ty = ppType (typedType ty) <+> fmt (typedValue ty)

ppSignBits :: Bool -> Bool -> Doc
Expand Down Expand Up @@ -636,10 +644,10 @@ ppClause c = case c of
Filter tv -> "filter" <+> ppTyped ppValue tv


ppTypedLabel :: BlockLabel -> Doc
ppTypedLabel :: LLVM => BlockLabel -> Doc
ppTypedLabel i = ppType (PrimType Label) <+> ppLabel i

ppSwitchEntry :: Type -> (Integer,BlockLabel) -> Doc
ppSwitchEntry :: LLVM => Type -> (Integer,BlockLabel) -> Doc
ppSwitchEntry ty (i,l) = ppType ty <+> integer i <> comma <+> ppTypedLabel l

ppVectorIndex :: LLVM => Value -> Doc
Expand Down Expand Up @@ -933,7 +941,7 @@ ppDITemplateValueParameter' pp vp = "!DITemplateValueParameter"
ppDITemplateValueParameter :: LLVM => DITemplateValueParameter -> Doc
ppDITemplateValueParameter = ppDITemplateValueParameter' ppLabel

ppDIBasicType :: DIBasicType -> Doc
ppDIBasicType :: LLVM => DIBasicType -> Doc
ppDIBasicType bt = "!DIBasicType"
<> parens (commas [ "tag:" <+> integral (dibtTag bt)
, "name:" <+> doubleQuotes (text (dibtName bt))
Expand Down Expand Up @@ -1019,18 +1027,18 @@ ppDIDerivedType' pp dt = "!DIDerivedType"
ppDIDerivedType :: LLVM => DIDerivedType -> Doc
ppDIDerivedType = ppDIDerivedType' ppLabel

ppDIEnumerator :: String -> Integer -> Bool -> Doc
ppDIEnumerator :: LLVM => String -> Integer -> Bool -> Doc
ppDIEnumerator n v u = "!DIEnumerator"
<> parens (commas [ "name:" <+> doubleQuotes (text n)
, "value:" <+> integral v
, "isUnsigned:" <+> ppBool u
])

ppDIExpression :: DIExpression -> Doc
ppDIExpression :: LLVM => DIExpression -> Doc
ppDIExpression e = "!DIExpression"
<> parens (commas (map integral (dieElements e)))

ppDIFile :: DIFile -> Doc
ppDIFile :: LLVM => DIFile -> Doc
ppDIFile f = "!DIFile"
<> parens (commas [ "filename:" <+> doubleQuotes (text (difFilename f))
, "directory:" <+> doubleQuotes (text (difDirectory f))
Expand Down Expand Up @@ -1133,7 +1141,7 @@ ppDISubprogram' pp sp = "!DISubprogram"
ppDISubprogram :: LLVM => DISubprogram -> Doc
ppDISubprogram = ppDISubprogram' ppLabel

ppDISubrange :: DISubrange -> Doc
ppDISubrange :: LLVM => DISubrange -> Doc
ppDISubrange sr = "!DISubrange"
<> parens (commas [ "count:" <+> integral (disrCount sr)
, "lowerBound:" <+> integral (disrLowerBound sr)
Expand All @@ -1156,7 +1164,7 @@ ppBool b | b = "true"
| otherwise = "false"

-- | Build a variable-argument argument list.
ppArgList :: Bool -> [Doc] -> Doc
ppArgList :: LLVM => Bool -> [Doc] -> Doc
ppArgList True ds = parens (commas (ds ++ ["..."]))
ppArgList False ds = parens (commas ds)

Expand All @@ -1170,12 +1178,12 @@ opt :: Bool -> Doc -> Doc
opt True = id
opt False = const empty

commas :: [Doc] -> Doc
commas = fsep . punctuate comma
commas :: LLVM => [Doc] -> Doc
commas = cfgCommaSep ?config . punctuate comma

-- | Helpful for all of the optional fields that appear in the
-- metadata values
mcommas :: [Maybe Doc] -> Doc
mcommas :: LLVM => [Maybe Doc] -> Doc
mcommas = commas . catMaybes

angles :: Doc -> Doc
Expand Down