llvm-hs-pretty 0.1.0.0 → 0.2.0.0
raw patch · 5 files changed
+123/−191 lines, 5 filesdep ~llvm-hs-pure
Dependency ranges changed: llvm-hs-pure
Files
- ChangeLog.md +12/−0
- README.md +7/−6
- llvm-hs-pretty.cabal +6/−4
- src/LLVM/Pretty.hs +98/−58
- src/LLVM/Typed.hs +0/−123
+ ChangeLog.md view
@@ -0,0 +1,12 @@+# Revision history for llvm-hs-typed++## 0.2++* Added support for DataLayout pretty printing.+* Migrated `Typed` module upstream into `llvm-hs`.+* Added support for instruction-level metadata printing.+* Expanded test suite for metadata tests.++## 0.1++* First version.
README.md view
@@ -2,6 +2,7 @@ -------------- [](https://travis-ci.org/llvm-hs/llvm-hs-pretty)+[](https://hackage.haskell.org/package/llvm-hs-pretty) A pretty printer for ``llvm-hs-pure``. Goal is to be able to pretty print a sufficiently large subset of the LLVM AST from pure Haskell without having to go@@ -10,12 +11,7 @@ Usage ----- -```bash-sudo apt-get install llvm-dev-5.0-```--There is a single function ``ppllvm`` that maps a LLVM.AST.Module to a-String.+There is a single function ``ppllvm`` that maps a LLVM.AST.Module to a String. ```haskell import LLVM.AST@@ -26,6 +22,11 @@ Tests -----++```bash+# This is only necessary for running the test suite+sudo apt-get install llvm-dev-5.0+``` The test suite currently consists of round tripping a LLVM IR from correct IR outputted by the llc toolchain, parsing into llvm-general AST and then printing
llvm-hs-pretty.cabal view
@@ -1,14 +1,16 @@ name: llvm-hs-pretty-version: 0.1.0.0+version: 0.2.0.0 license: MIT+synopsis: A pretty printer for LLVM IR. +description: A pretty printer for the LLVM AST types provided by llvm-hs. license-file: LICENSE author: Stephen Diehl maintainer: stephen.m.diehl@gmail.com build-type: Simple category: Compilers-extra-source-files: README.md cabal-version: >=1.10 homepage: https://github.com/llvm-hs/llvm-hs-pretty+extra-source-files: README.md ChangeLog.md Synopsis: Pretty printer for LLVM IR. Description:@@ -22,7 +24,7 @@ hs-source-dirs: src exposed-modules: LLVM.Pretty- LLVM.Typed+ other-modules: LLVM.Token ghc-options: -fwarn-incomplete-patterns@@ -31,7 +33,7 @@ array >= 0.5, base >= 4.6 && < 5.0, bytestring >= 0.10,- llvm-hs-pure >= 5.1,+ llvm-hs-pure >= 5.1.1, text >= 0.1, wl-pprint-text >= 1.1
src/LLVM/Pretty.hs view
@@ -15,13 +15,15 @@ import Prelude hiding ((<$>)) import GHC.Word -import LLVM.Typed+import LLVM.AST.Typed import LLVM.AST import LLVM.AST.Global import LLVM.AST.Type +import LLVM.DataLayout import LLVM.AST.Attribute+import LLVM.AST.DataLayout import LLVM.AST.COMDAT import qualified LLVM.AST.Linkage as L import qualified LLVM.AST.Visibility as V@@ -131,6 +133,12 @@ instance PP Integer where pp = integer +instance PP BS.ShortByteString where+ pp = pp . unShort++instance PP [Char] where+ pp = text . pack+ instance PP Name where pp (Name nm) | BS.null nm = dquotes empty@@ -378,6 +386,9 @@ L.LinkOnceODR -> "linkonce_odr" L.WeakODR -> "weak_odr" +instance PP InstructionMetadata where+ pp meta = commas ["!" <> pp x <> "!" <> ("{" <> pp y <> "}") | (x,y) <- meta]+ instance PP MetadataNodeID where pp (MetadataNodeID x) = "!" <> int (fromIntegral x) @@ -394,104 +405,120 @@ instance PP Terminator where pp = \case- Br dest meta -> "br" <+> label (pp dest)- Ret val meta -> "ret" <+> maybe "void" ppTyped val+ Br dest meta -> "br" <+> label (pp dest) <+> ppInstrMeta meta++ Ret val meta -> "ret" <+> maybe "void" ppTyped val <+> ppInstrMeta meta+ CondBr cond tdest fdest meta -> "br" <+> ppTyped cond `cma` label (pp tdest) `cma` label (pp fdest)+ <+> ppInstrMeta meta+ Switch {..} -> "switch" <+> ppTyped operand0' `cma` label (pp defaultDest) <+> brackets (hsep [ ppTyped v `cma` label (pp l) | (v,l) <- dests ])- Unreachable {..} -> "unreachable"+ <+> ppInstrMeta metadata'++ Unreachable {..} -> "unreachable" <+> ppInstrMeta metadata'+ IndirectBr op dests meta -> "indirectbr" <+> ppTyped op `cma` brackets (hsep [ label (pp l) | l <- dests ])+ <+> ppInstrMeta meta e @ Invoke {..} -> ppInvoke e <+> "to" <+> label (pp returnDest) <+> "unwind" <+> label (pp exceptionDest)- Resume op meta -> "resume "<+> ppTyped op+ <+> ppInstrMeta metadata'++ Resume op meta -> "resume "<+> ppTyped op <+> ppInstrMeta meta+ CleanupRet pad dest meta ->- "cleanupret" <+> "from" <+> pp pad <+> "unwind" <+> maybe "to caller" (label . pp) dest+ "cleanupret" <+> "from" <+> pp pad <+> "unwind" <+> maybe "to caller" (label . pp) dest+ <+> ppInstrMeta meta+ CatchRet catchPad succ meta -> "catchret" <+> "from" <+> pp catchPad <+> "to" <+> label (pp succ)+ <+> ppInstrMeta meta+ CatchSwitch {..} -> "catchswitch" <+> "within" <+> pp parentPad' <+> brackets (commas (map (label . pp) (toList catchHandlers))) <+> "unwind" <+> "to" <+> maybe "caller" pp defaultUnwindDest+ <+> ppInstrMeta metadata' instance PP Instruction where pp = \case- Add {..} -> "add" <+> ppTyped operand0 `cma` pp operand1- Sub {..} -> "sub" <+> ppTyped operand0 `cma` pp operand1- Mul {..} -> "mul" <+> ppTyped operand0 `cma` pp operand1- Shl {..} -> "shl" <+> ppTyped operand0 `cma` pp operand1- AShr {..} -> "ashr" <+> ppTyped operand0 `cma` pp operand1- LShr {..} -> "lshr" <+> ppTyped operand0 `cma` pp operand1- And {..} -> "and" <+> ppTyped operand0 `cma` pp operand1- Or {..} -> "or" <+> ppTyped operand0 `cma` pp operand1- Xor {..} -> "xor" <+> ppTyped operand0 `cma` pp operand1- SDiv {..} -> "sdiv" <+> ppTyped operand0 `cma` pp operand1- UDiv {..} -> "udiv" <+> ppTyped operand0 `cma` pp operand1- SRem {..} -> "srem" <+> ppTyped operand0 `cma` pp operand1- URem {..} -> "urem" <+> ppTyped operand0 `cma` pp operand1+ Add {..} -> "add" <+> ppTyped operand0 `cma` pp operand1 <+> ppInstrMeta metadata+ Sub {..} -> "sub" <+> ppTyped operand0 `cma` pp operand1 <+> ppInstrMeta metadata+ Mul {..} -> "mul" <+> ppTyped operand0 `cma` pp operand1 <+> ppInstrMeta metadata+ Shl {..} -> "shl" <+> ppTyped operand0 `cma` pp operand1 <+> ppInstrMeta metadata+ AShr {..} -> "ashr" <+> ppTyped operand0 `cma` pp operand1 <+> ppInstrMeta metadata+ LShr {..} -> "lshr" <+> ppTyped operand0 `cma` pp operand1 <+> ppInstrMeta metadata+ And {..} -> "and" <+> ppTyped operand0 `cma` pp operand1 <+> ppInstrMeta metadata+ Or {..} -> "or" <+> ppTyped operand0 `cma` pp operand1 <+> ppInstrMeta metadata+ Xor {..} -> "xor" <+> ppTyped operand0 `cma` pp operand1 <+> ppInstrMeta metadata+ SDiv {..} -> "sdiv" <+> ppTyped operand0 `cma` pp operand1 <+> ppInstrMeta metadata+ UDiv {..} -> "udiv" <+> ppTyped operand0 `cma` pp operand1 <+> ppInstrMeta metadata+ SRem {..} -> "srem" <+> ppTyped operand0 `cma` pp operand1 <+> ppInstrMeta metadata+ URem {..} -> "urem" <+> ppTyped operand0 `cma` pp operand1 <+> ppInstrMeta metadata - FAdd {..} -> "fadd" <+> ppTyped operand0 `cma` pp operand1- FSub {..} -> "fsub" <+> ppTyped operand0 `cma` pp operand1- FMul {..} -> "fmul" <+> ppTyped operand0 `cma` pp operand1- FDiv {..} -> "fdiv" <+> ppTyped operand0 `cma` pp operand1- FRem {..} -> "frem" <+> ppTyped operand0 `cma` pp operand1- FCmp {..} -> "fcmp" <+> pp fpPredicate <+> ppTyped operand0 `cma` pp operand1+ FAdd {..} -> "fadd" <+> ppTyped operand0 `cma` pp operand1 <+> ppInstrMeta metadata+ FSub {..} -> "fsub" <+> ppTyped operand0 `cma` pp operand1 <+> ppInstrMeta metadata+ FMul {..} -> "fmul" <+> ppTyped operand0 `cma` pp operand1 <+> ppInstrMeta metadata+ FDiv {..} -> "fdiv" <+> ppTyped operand0 `cma` pp operand1 <+> ppInstrMeta metadata+ FRem {..} -> "frem" <+> ppTyped operand0 `cma` pp operand1 <+> ppInstrMeta metadata+ FCmp {..} -> "fcmp" <+> pp fpPredicate <+> ppTyped operand0 `cma` pp operand1 <+> ppInstrMeta metadata - Alloca {..} -> "alloca" <+> pp allocatedType <> num <> ppAlign alignment+ Alloca {..} -> "alloca" <+> pp allocatedType <> num <> ppAlign alignment <+> ppInstrMeta metadata where num = case numElements of Nothing -> empty Just o -> "," <+> ppTyped o Store {..} -> "store" <+> ppTyped value `cma` ppTyped address <> ppAlign alignment- Load {..} -> "load" <+> pp argTy `cma` ppTyped address <> ppAlign alignment+ Load {..} -> "load" <+> pp argTy `cma` ppTyped address <> ppAlign alignment <+> ppInstrMeta metadata where PointerType argTy _ = typeOf address- Phi {..} -> "phi" <+> pp type' <+> commas (fmap phiIncoming incomingValues)+ Phi {..} -> "phi" <+> pp type' <+> commas (fmap phiIncoming incomingValues) <+> ppInstrMeta metadata - ICmp {..} -> "icmp" <+> pp iPredicate <+> ppTyped operand0 `cma` pp operand1+ ICmp {..} -> "icmp" <+> pp iPredicate <+> ppTyped operand0 `cma` pp operand1 <+> ppInstrMeta metadata - c@Call {..} -> ppCall c- Select {..} -> "select" <+> commas [ppTyped condition', ppTyped trueValue, ppTyped falseValue]- SExt {..} -> "sext" <+> ppTyped operand0 <+> "to" <+> pp type'- ZExt {..} -> "zext" <+> ppTyped operand0 <+> "to" <+> pp type'- FPExt {..} -> "fpext" <+> ppTyped operand0 <+> "to" <+> pp type'- Trunc {..} -> "trunc" <+> ppTyped operand0 <+> "to" <+> pp type'- FPTrunc {..} -> "fptrunc" <+> ppTyped operand0 <+> "to" <+> pp type'+ c@Call {..} -> ppCall c <+> ppInstrMeta metadata+ Select {..} -> "select" <+> commas [ppTyped condition', ppTyped trueValue, ppTyped falseValue] <+> ppInstrMeta metadata+ SExt {..} -> "sext" <+> ppTyped operand0 <+> "to" <+> pp type' <+> ppInstrMeta metadata <+> ppInstrMeta metadata+ ZExt {..} -> "zext" <+> ppTyped operand0 <+> "to" <+> pp type' <+> ppInstrMeta metadata <+> ppInstrMeta metadata+ FPExt {..} -> "fpext" <+> ppTyped operand0 <+> "to" <+> pp type' <+> ppInstrMeta metadata <+> ppInstrMeta metadata+ Trunc {..} -> "trunc" <+> ppTyped operand0 <+> "to" <+> pp type' <+> ppInstrMeta metadata <+> ppInstrMeta metadata+ FPTrunc {..} -> "fptrunc" <+> ppTyped operand0 <+> "to" <+> pp type' <+> ppInstrMeta metadata <+> ppInstrMeta metadata - GetElementPtr {..} -> "getelementptr" <+> bounds inBounds <+> commas (pp argTy : fmap ppTyped (address:indices))+ GetElementPtr {..} -> "getelementptr" <+> bounds inBounds <+> commas (pp argTy : fmap ppTyped (address:indices)) <+> ppInstrMeta metadata where argTy = getElementType $ typeOf address- ExtractValue {..} -> "extractvalue" <+> commas (ppTyped aggregate : fmap pp indices')+ ExtractValue {..} -> "extractvalue" <+> commas (ppTyped aggregate : fmap pp indices') <+> ppInstrMeta metadata - BitCast {..} -> "bitcast" <+> ppTyped operand0 <+> "to" <+> pp type'- FPToUI {..} -> "fptoui" <+> ppTyped operand0 <+> "to" <+> pp type'- FPToSI {..} -> "fptosi" <+> ppTyped operand0 <+> "to" <+> pp type'- UIToFP {..} -> "uitofp" <+> ppTyped operand0 <+> "to" <+> pp type'- SIToFP {..} -> "sitofp" <+> ppTyped operand0 <+> "to" <+> pp type'- PtrToInt {..} -> "ptrtoint" <+> ppTyped operand0 <+> "to" <+> pp type'- IntToPtr {..} -> "inttoptr" <+> ppTyped operand0 <+> "to" <+> pp type'+ BitCast {..} -> "bitcast" <+> ppTyped operand0 <+> "to" <+> pp type' <+> ppInstrMeta metadata+ FPToUI {..} -> "fptoui" <+> ppTyped operand0 <+> "to" <+> pp type' <+> ppInstrMeta metadata+ FPToSI {..} -> "fptosi" <+> ppTyped operand0 <+> "to" <+> pp type' <+> ppInstrMeta metadata+ UIToFP {..} -> "uitofp" <+> ppTyped operand0 <+> "to" <+> pp type' <+> ppInstrMeta metadata+ SIToFP {..} -> "sitofp" <+> ppTyped operand0 <+> "to" <+> pp type' <+> ppInstrMeta metadata+ PtrToInt {..} -> "ptrtoint" <+> ppTyped operand0 <+> "to" <+> pp type' <+> ppInstrMeta metadata+ IntToPtr {..} -> "inttoptr" <+> ppTyped operand0 <+> "to" <+> pp type' <+> ppInstrMeta metadata - InsertElement {..} -> "insertelement" <+> commas [ppTyped vector, ppTyped element, ppTyped index]- ShuffleVector {..} -> "shufflevector" <+> commas [ppTyped operand0, ppTyped operand1, ppTyped mask]- ExtractElement {..} -> "extractelement" <+> commas [ppTyped vector, ppTyped index]- InsertValue {..} -> "insertvalue" <+> commas (ppTyped aggregate : ppTyped element : fmap pp indices')+ InsertElement {..} -> "insertelement" <+> commas [ppTyped vector, ppTyped element, ppTyped index] <+> ppInstrMeta metadata+ ShuffleVector {..} -> "shufflevector" <+> commas [ppTyped operand0, ppTyped operand1, ppTyped mask] <+> ppInstrMeta metadata+ ExtractElement {..} -> "extractelement" <+> commas [ppTyped vector, ppTyped index] <+> ppInstrMeta metadata+ InsertValue {..} -> "insertvalue" <+> commas (ppTyped aggregate : ppTyped element : fmap pp indices') <+> ppInstrMeta metadata - Fence {..} -> "fence" <+> pp atomicity- AtomicRMW {..} -> "atomicrmw" <+> ppVolatile volatile <+> pp rmwOperation <+> ppTyped address `cma` ppTyped value <+> pp atomicity+ Fence {..} -> "fence" <+> pp atomicity <+> ppInstrMeta metadata+ AtomicRMW {..} -> "atomicrmw" <+> ppVolatile volatile <+> pp rmwOperation <+> ppTyped address `cma` ppTyped value <+> pp atomicity <+> ppInstrMeta metadata CmpXchg {..} -> "cmpxchg" <+> ppVolatile volatile <+> ppTyped address `cma` ppTyped expected `cma` ppTyped replacement- <+> pp atomicity <+> pp failureMemoryOrdering+ <+> pp atomicity <+> pp failureMemoryOrdering <+> ppInstrMeta metadata - AddrSpaceCast {..} -> "addrspacecast" <+> ppTyped operand0 <+> "to" <+> pp type'- VAArg {..} -> "va_arg" <+> ppTyped argList `cma` pp type'+ AddrSpaceCast {..} -> "addrspacecast" <+> ppTyped operand0 <+> "to" <+> pp type' <+> ppInstrMeta metadata+ VAArg {..} -> "va_arg" <+> ppTyped argList `cma` pp type' <+> ppInstrMeta metadata LandingPad {..} ->- "landingpad" <+> pp type' <+> ppBool "cleanup" cleanup+ "landingpad" <+> pp type' <+> ppBool "cleanup" cleanup <+> ppInstrMeta metadata <+> commas (fmap pp clauses)- CatchPad {..} -> "catchpad" <+> "within" <+> pp catchSwitch <+> brackets (commas (map ppTyped args))- CleanupPad {..} -> "cleanuppad" <+> "within" <+> pp parentPad <+> brackets (commas (map ppTyped args))+ CatchPad {..} -> "catchpad" <+> "within" <+> pp catchSwitch <+> brackets (commas (map ppTyped args)) <+> ppInstrMeta metadata+ CleanupPad {..} -> "cleanuppad" <+> "within" <+> pp parentPad <+> brackets (commas (map ppTyped args)) <+> ppInstrMeta metadata where bounds True = "inbounds"@@ -611,7 +638,13 @@ instance PP Module where pp Module {..} = let header = printf "; ModuleID = '%s'" (unShort moduleName) in- hlinecat (fromString header : (fmap pp moduleDefinitions))+ let target = case moduleTargetTriple of+ Nothing -> mempty+ Just target -> "target triple =" <+> dquotes (pp target) in+ let layout = case moduleDataLayout of+ Nothing -> mempty+ Just layout -> "target datalayout =" <+> dquotes (pp layout) in+ hlinecat (fromString header : (layout </> target) : (fmap pp moduleDefinitions)) instance PP FP.FloatingPointPredicate where pp op = case op of@@ -677,6 +710,9 @@ RMW.UMax -> "umax" RMW.UMin -> "umin" +instance PP DataLayout where+ pp x = pp (BL.unpack (dataLayoutToString x))+ ------------------------------------------------------------------------------- -- Special Case Hacks -------------------------------------------------------------------------------@@ -783,3 +819,7 @@ specialFP :: RealFloat a => a -> Bool specialFP f = isNaN f || f == 1 / 0 || f == - 1 / 0++ppInstrMeta :: InstructionMetadata -> Doc+ppInstrMeta [] = mempty+ppInstrMeta xs = "," <> pp xs
− src/LLVM/Typed.hs
@@ -1,123 +0,0 @@-{-# LANGUAGE RecordWildCards #-}-{-# LANGUAGE FlexibleInstances #-}--module LLVM.Typed (- Typed(..),- getElementType,-) where--import LLVM.AST-import LLVM.AST.Global-import LLVM.AST.Type--import qualified LLVM.AST.Constant as C-import qualified LLVM.AST.Float as F---------- Reasoning about types--------class Typed a where- typeOf :: a -> Type--instance Typed Operand where- typeOf (LocalReference t _) = t- typeOf (ConstantOperand c) = typeOf c- typeOf _ = MetadataType--instance Typed CallableOperand where- typeOf (Right op) = typeOf op- typeOf (Left asm) = error "typeOf inline assembler is not defined. (Malformed AST)"--instance Typed C.Constant where- typeOf (C.Int bits _) = IntegerType bits- typeOf (C.Float float) = typeOf float- typeOf (C.Null t) = t- typeOf (C.Struct {..}) = StructureType isPacked (map typeOf memberValues)- typeOf (C.Array {..}) = ArrayType (fromIntegral $ length memberValues) memberType- typeOf (C.Vector {..}) = VectorType (fromIntegral $ length memberValues) $- case memberValues of- [] -> VoidType {- error "Vectors of size zero are not allowed" -}- (x:_) -> typeOf x- typeOf (C.Undef t) = t- typeOf (C.BlockAddress {..}) = ptr i8- typeOf (C.GlobalReference t _) = t- typeOf (C.Add {..}) = typeOf operand0- typeOf (C.FAdd {..}) = typeOf operand0- typeOf (C.FDiv {..}) = typeOf operand0- typeOf (C.FRem {..}) = typeOf operand0- typeOf (C.Sub {..}) = typeOf operand0- typeOf (C.FSub {..}) = typeOf operand0- typeOf (C.Mul {..}) = typeOf operand0- typeOf (C.FMul {..}) = typeOf operand0- typeOf (C.UDiv {..}) = typeOf operand0- typeOf (C.SDiv {..}) = typeOf operand0- typeOf (C.URem {..}) = typeOf operand0- typeOf (C.SRem {..}) = typeOf operand0- typeOf (C.Shl {..}) = typeOf operand0- typeOf (C.LShr {..}) = typeOf operand0- typeOf (C.AShr {..}) = typeOf operand0- typeOf (C.And {..}) = typeOf operand0- typeOf (C.Or {..}) = typeOf operand0- typeOf (C.Xor {..}) = typeOf operand0- typeOf (C.GetElementPtr {..}) = getElementPtrType (typeOf address) indices- typeOf (C.Trunc {..}) = type'- typeOf (C.ZExt {..}) = type'- typeOf (C.SExt {..}) = type'- typeOf (C.FPToUI {..}) = type'- typeOf (C.FPToSI {..}) = type'- typeOf (C.UIToFP {..}) = type'- typeOf (C.SIToFP {..}) = type'- typeOf (C.FPTrunc {..}) = type'- typeOf (C.FPExt {..}) = type'- typeOf (C.PtrToInt {..}) = type'- typeOf (C.IntToPtr {..}) = type'- typeOf (C.BitCast {..}) = type'- typeOf (C.ICmp {..}) = case (typeOf operand0) of- (VectorType n _) -> VectorType n i1- _ -> i1- typeOf (C.FCmp {..}) = case (typeOf operand0) of- (VectorType n _) -> VectorType n i1- _ -> i1- typeOf (C.Select {..}) = typeOf trueValue- typeOf (C.ExtractElement {..}) = case typeOf vector of- (VectorType _ t) -> t- _ -> VoidType {- error "The first operand of an extractelement instruction is a value of vector type." -}- typeOf (C.InsertElement {..}) = typeOf vector- typeOf (C.ShuffleVector {..}) = case (typeOf operand0, typeOf mask) of- (VectorType _ t, VectorType m _) -> VectorType m t- _ -> VoidType {- error -}- typeOf (C.ExtractValue {..}) = extractValueType (typeOf aggregate) indices- typeOf (C.InsertValue {..}) = typeOf aggregate- typeOf (C.TokenNone) = TokenType- typeOf (C.AddrSpaceCast {..}) = type'--getElementPtrType :: Type -> [C.Constant] -> Type-getElementPtrType ty [] = ptr ty-getElementPtrType (PointerType ty _) (_:is) = getElementPtrType ty is-getElementPtrType (StructureType _ elTys) (C.Int 32 val:is) =- getElementPtrType (elTys !! fromIntegral val) is-getElementPtrType (VectorType _ elTy) (_:is) = getElementPtrType elTy is-getElementPtrType (ArrayType _ elTy) (_:is) = getElementPtrType elTy is--getElementType :: Type -> Type-getElementType (PointerType t _) = t-getElementType t = error $ "this should be a pointer type" ++ show t--extractValueType = error "extract"--instance Typed F.SomeFloat where- typeOf (F.Half _) = FloatingPointType HalfFP- typeOf (F.Single _) = FloatingPointType FloatFP- typeOf (F.Double _) = FloatingPointType DoubleFP- typeOf (F.Quadruple _ _) = FloatingPointType FP128FP- typeOf (F.X86_FP80 _ _) = FloatingPointType X86_FP80FP- typeOf (F.PPC_FP128 _ _) = FloatingPointType PPC_FP128FP--instance Typed Global where- typeOf (GlobalVariable {..}) = type'- typeOf (GlobalAlias {..}) = type'- typeOf (Function {..}) = let (params, isVarArg) = parameters- in FunctionType returnType (map typeOf params) isVarArg-instance Typed Parameter where- typeOf (Parameter t _ _) = t