diff --git a/ChangeLog.md b/ChangeLog.md new file mode 100644 --- /dev/null +++ b/ChangeLog.md @@ -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. diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -2,6 +2,7 @@ -------------- [![Build Status](https://travis-ci.org/llvm-hs/llvm-hs-pretty.svg)](https://travis-ci.org/llvm-hs/llvm-hs-pretty) +[![Hackage](https://img.shields.io/hackage/v/llvm-hs-pretty.svg)](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 diff --git a/llvm-hs-pretty.cabal b/llvm-hs-pretty.cabal --- a/llvm-hs-pretty.cabal +++ b/llvm-hs-pretty.cabal @@ -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 diff --git a/src/LLVM/Pretty.hs b/src/LLVM/Pretty.hs --- a/src/LLVM/Pretty.hs +++ b/src/LLVM/Pretty.hs @@ -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 diff --git a/src/LLVM/Typed.hs b/src/LLVM/Typed.hs deleted file mode 100644 --- a/src/LLVM/Typed.hs +++ /dev/null @@ -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