language-cil 0.2.2 → 0.3.1

raw patch · 5 files changed

+232/−186 lines, 5 filesdep ~bool-extrasPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: bool-extras

API changes (from Hackage documentation)

Files

• language-cil.cabal +2/−2
• src/Language/Cil/Analysis.hs +11/−11
• src/Language/Cil/Build.hs +175/−150
• src/Language/Cil/Pretty.hs +28/−10
• src/Language/Cil/Syntax.hs +16/−13

@@ -1,5 +1,5 @@ name:                language-cil-version:             0.2.2+version:             0.3.1 homepage:            https://github.com/tomlokhorst/language-cil synopsis:            Manipulating Common Intermediate Language AST description:         Language-Cil is a Haskell library for manipulating CIL@@ -27,7 +27,7 @@ library   hs-source-dirs:    src   build-depends:     base > 3 && < 5,-                     bool-extras >= 0.3.0 && < 0.4+                     bool-extras >= 0.4.0 && < 0.5   exposed-modules:   Language.Cil                      Language.Cil.Analysis                      Language.Cil.Build

@@ -3,28 +3,28 @@ --  module Language.Cil.Analysis (-    instructions+    opcodes   ) where  import Language.Cil.Syntax  class Ast a where-  -- A concatenated list of all instructions.-  instructions :: a -> [Instr]+  -- A concatenated list of all opcodes.+  opcodes :: a -> [OpCode]  instance Ast Assembly where-  instructions (Assembly _ _ td) = concatMap instructions td+  opcodes (Assembly _ _ td) = concatMap opcodes td  instance Ast TypeDef where-  instructions (Class _ _ _ _ cd)      = concatMap instructions cd-  instructions (GenericClass _ _ _ cd) = concatMap instructions cd+  opcodes (Class _ _ _ _ cd)      = concatMap opcodes cd+  opcodes (GenericClass _ _ _ cd) = concatMap opcodes cd  instance Ast ClassDecl where-  instructions (FieldDef  _)  = []-  instructions (MethodDef md) = instructions md-  instructions (TypeDef td)   = instructions td+  opcodes (FieldDef  _)  = []+  opcodes (MethodDef md) = opcodes md+  opcodes (TypeDef td)   = opcodes td  instance Ast MethodDef where-  instructions (Constructor _ _ _ md) = [ i | Instr i <- md ]-  instructions (Method _ _ _ _ md)    = [ i | Instr i <- md ]+  opcodes (Constructor _ _ _ md) = [ o | OpCode o <- md ]+  opcodes (Method _ _ _ _ md)    = [ o | OpCode o <- md ] 

@@ -12,7 +12,7 @@   , localsInit   , maxStack -  -- * mdecl functions+  -- * OpCode functions   , add   , add_ovf   , add_ovf_un@@ -29,6 +29,7 @@   , brtrue   , call   , callvirt+  , castclass   , ceq   , cgt   , ckfinite@@ -39,6 +40,8 @@   , isinst   , ldarg   , ldargN+  , ldarga+  , ldargaN   , ldc_i4   , ldc_i8   , ldc_r4@@ -60,6 +63,7 @@   , ldfld   , ldflda   , ldftn+  , ldftn_instance   , ldind_i   , ldind_i1   , ldind_i2@@ -80,6 +84,7 @@   , ldsfld   , ldsflda   , ldstr+  , ldtoken   , mul   , mul_ovf   , mul_ovf_un@@ -119,12 +124,14 @@   , sub   , sub_ovf   , sub_ovf_un+  , switch   , tail   , tailcall   , throw   , unaligned   , unalignedPtr   , unbox+  , unbox_any   , volatile   , volatilePtr   , xor@@ -166,384 +173,405 @@ maxStack x = Directive (MaxStack x)  --- mdecl functions+-- OpCode functions  add :: MethodDecl-add = mdecl $ Add+add = OpCode $ Add  add_ovf :: MethodDecl-add_ovf = mdecl $ Add_ovf+add_ovf = OpCode $ Add_ovf  add_ovf_un :: MethodDecl-add_ovf_un = mdecl $ Add_ovf_un+add_ovf_un = OpCode $ Add_ovf_un  and :: MethodDecl-and = mdecl $ And+and = OpCode $ And  beq :: Label -> MethodDecl-beq = mdecl . Beq+beq = OpCode . Beq  bge :: Label -> MethodDecl-bge = mdecl . Bge+bge = OpCode . Bge  bgt :: Label -> MethodDecl-bgt = mdecl . Bgt+bgt = OpCode . Bgt  ble :: Label -> MethodDecl-ble = mdecl . Ble+ble = OpCode . Ble  blt :: Label -> MethodDecl-blt = mdecl . Blt+blt = OpCode . Blt  box :: PrimitiveType -> MethodDecl-box = mdecl . Box+box = OpCode . Box  unbox :: PrimitiveType -> MethodDecl-unbox = mdecl . Unbox+unbox = OpCode . Unbox +unbox_any :: PrimitiveType -> MethodDecl+unbox_any = OpCode . Unbox_any+ br :: Label -> MethodDecl-br = mdecl . Br+br = OpCode . Br  break :: MethodDecl-break = mdecl $ Break+break = OpCode $ Break  brfalse :: Label -> MethodDecl-brfalse = mdecl . Brfalse+brfalse = OpCode . Brfalse  brtrue :: Label -> MethodDecl-brtrue = mdecl . Brtrue+brtrue = OpCode . Brtrue  call :: [CallConv] -> PrimitiveType -> AssemblyName -> TypeName -> MethodName -> [PrimitiveType] -> MethodDecl-call ccs p l t m ps = mdecl $ Call ccs p l t m ps+call ccs p l t m ps = OpCode $ Call ccs p l t m ps  callvirt :: PrimitiveType -> AssemblyName -> TypeName -> MethodName -> [PrimitiveType] -> MethodDecl-callvirt p l t m ps = mdecl $ CallVirt p l t m ps+callvirt p l t m ps = OpCode $ CallVirt p l t m ps +castclass :: PrimitiveType -> MethodDecl+castclass = OpCode . Castclass+ ceq, cgt, clt :: MethodDecl-ceq = mdecl $ Ceq-cgt = mdecl $ Cgt-clt = mdecl $ Clt+ceq = OpCode $ Ceq+cgt = OpCode $ Cgt+clt = OpCode $ Clt  ckfinite :: MethodDecl-ckfinite = mdecl $ Ckfinite+ckfinite = OpCode $ Ckfinite  dup :: MethodDecl-dup = mdecl $ Dup+dup = OpCode $ Dup  div :: MethodDecl-div = mdecl $ Div+div = OpCode $ Div  div_un :: MethodDecl-div_un = mdecl $ Div_un+div_un = OpCode $ Div_un  isinst :: TypeName -> MethodDecl-isinst = mdecl . Isinst+isinst = OpCode . Isinst  ldarg :: Offset -> MethodDecl-ldarg 0 = mdecl $ Ldarg_0-ldarg 1 = mdecl $ Ldarg_1-ldarg 2 = mdecl $ Ldarg_2-ldarg 3 = mdecl $ Ldarg_3-ldarg x = mdecl $ Ldarg x+ldarg 0 = OpCode $ Ldarg_0+ldarg 1 = OpCode $ Ldarg_1+ldarg 2 = OpCode $ Ldarg_2+ldarg 3 = OpCode $ Ldarg_3+ldarg x = OpCode $ Ldarg x  ldargN :: DottedName -> MethodDecl-ldargN = mdecl . LdargN+ldargN = OpCode . LdargN +ldarga :: Offset -> MethodDecl+ldarga = OpCode . Ldarga++ldargaN :: DottedName -> MethodDecl+ldargaN = OpCode . LdargaN+ ldc_i4 :: Integer -> MethodDecl-ldc_i4 (-1) = mdecl $ Ldc_i4_m1-ldc_i4 0    = mdecl $ Ldc_i4_0-ldc_i4 1    = mdecl $ Ldc_i4_1-ldc_i4 2    = mdecl $ Ldc_i4_2-ldc_i4 3    = mdecl $ Ldc_i4_3-ldc_i4 4    = mdecl $ Ldc_i4_4-ldc_i4 5    = mdecl $ Ldc_i4_5-ldc_i4 6    = mdecl $ Ldc_i4_6-ldc_i4 7    = mdecl $ Ldc_i4_7-ldc_i4 8    = mdecl $ Ldc_i4_8-ldc_i4 x    = mdecl $ if -127 <= x && x <= 128+ldc_i4 (-1) = OpCode $ Ldc_i4_m1+ldc_i4 0    = OpCode $ Ldc_i4_0+ldc_i4 1    = OpCode $ Ldc_i4_1+ldc_i4 2    = OpCode $ Ldc_i4_2+ldc_i4 3    = OpCode $ Ldc_i4_3+ldc_i4 4    = OpCode $ Ldc_i4_4+ldc_i4 5    = OpCode $ Ldc_i4_5+ldc_i4 6    = OpCode $ Ldc_i4_6+ldc_i4 7    = OpCode $ Ldc_i4_7+ldc_i4 8    = OpCode $ Ldc_i4_8+ldc_i4 x    = OpCode $ if -127 <= x && x <= 128                       then Ldc_i4_s (fromInteger x)                       else Ldc_i4 x  ldc_i8 :: Integer -> MethodDecl-ldc_i8 = mdecl . Ldc_i8+ldc_i8 = OpCode . Ldc_i8  ldc_r4 :: Float -> MethodDecl-ldc_r4 = mdecl . Ldc_r4+ldc_r4 = OpCode . Ldc_r4  ldc_r8 :: Double -> MethodDecl-ldc_r8 = mdecl . Ldc_r8+ldc_r8 = OpCode . Ldc_r8  ldchar :: Char -> MethodDecl ldchar c = ldc_i4 (toInteger $ ord c)  ldelem_i :: MethodDecl-ldelem_i = mdecl $ Ldelem_i+ldelem_i = OpCode $ Ldelem_i  ldelem_i1 :: MethodDecl-ldelem_i1 = mdecl $ Ldelem_i1+ldelem_i1 = OpCode $ Ldelem_i1  ldelem_i2 :: MethodDecl-ldelem_i2 = mdecl $ Ldelem_i2+ldelem_i2 = OpCode $ Ldelem_i2  ldelem_i4 :: MethodDecl-ldelem_i4 = mdecl $ Ldelem_i4+ldelem_i4 = OpCode $ Ldelem_i4  ldelem_i8 :: MethodDecl-ldelem_i8 = mdecl $ Ldelem_i8+ldelem_i8 = OpCode $ Ldelem_i8  ldelem_u1 :: MethodDecl-ldelem_u1 = mdecl $ Ldelem_u1+ldelem_u1 = OpCode $ Ldelem_u1  ldelem_u2 :: MethodDecl-ldelem_u2 = mdecl $ Ldelem_u2+ldelem_u2 = OpCode $ Ldelem_u2  ldelem_u4 :: MethodDecl-ldelem_u4 = mdecl $ Ldelem_u4+ldelem_u4 = OpCode $ Ldelem_u4  ldelem_u8 :: MethodDecl-ldelem_u8 = mdecl $ Ldelem_u8+ldelem_u8 = OpCode $ Ldelem_u8  ldelem_r4 :: MethodDecl-ldelem_r4 = mdecl $ Ldelem_r4+ldelem_r4 = OpCode $ Ldelem_r4  ldelem_r8 :: MethodDecl-ldelem_r8 = mdecl $ Ldelem_r8+ldelem_r8 = OpCode $ Ldelem_r8  ldelem_ref :: MethodDecl-ldelem_ref = mdecl $ Ldelem_ref+ldelem_ref = OpCode $ Ldelem_ref  ldelema :: MethodDecl-ldelema = mdecl $ Ldelema+ldelema = OpCode $ Ldelema  ldfld :: PrimitiveType -> AssemblyName -> TypeName -> FieldName -> MethodDecl-ldfld p a t f = mdecl $ Ldfld p a t f+ldfld p a t f = OpCode $ Ldfld p a t f  ldflda :: PrimitiveType -> AssemblyName -> TypeName -> FieldName -> MethodDecl-ldflda p a t f = mdecl $ Ldflda p a t f+ldflda p a t f = OpCode $ Ldflda p a t f +ldftn_ :: [CallConv] -> PrimitiveType -> AssemblyName -> TypeName -> MethodName -> [PrimitiveType] -> MethodDecl+ldftn_ cc p a t m ps = OpCode $ Ldftn cc p a t m ps+ ldftn :: PrimitiveType -> AssemblyName -> TypeName -> MethodName -> [PrimitiveType] -> MethodDecl-ldftn p a t m ps = mdecl $ Ldftn p a t m ps+ldftn = ldftn_ [] +ldftn_instance :: PrimitiveType -> AssemblyName -> TypeName -> MethodName -> [PrimitiveType] -> MethodDecl+ldftn_instance = ldftn_ [CcInstance]+ ldind_i :: MethodDecl-ldind_i = mdecl $ Ldind_i+ldind_i = OpCode $ Ldind_i  ldind_i1 :: MethodDecl-ldind_i1 = mdecl $ Ldind_i1+ldind_i1 = OpCode $ Ldind_i1  ldind_i2 :: MethodDecl-ldind_i2 = mdecl $ Ldind_i2+ldind_i2 = OpCode $ Ldind_i2  ldind_i4 :: MethodDecl-ldind_i4 = mdecl $ Ldind_i4+ldind_i4 = OpCode $ Ldind_i4  ldind_i8 :: MethodDecl-ldind_i8 = mdecl $ Ldind_i8+ldind_i8 = OpCode $ Ldind_i8  ldind_r4 :: MethodDecl-ldind_r4 = mdecl $ Ldind_r4+ldind_r4 = OpCode $ Ldind_r4  ldind_r8 :: MethodDecl-ldind_r8 = mdecl $ Ldind_r8+ldind_r8 = OpCode $ Ldind_r8  ldind_ref :: MethodDecl-ldind_ref = mdecl $ Ldind_ref+ldind_ref = OpCode $ Ldind_ref  ldind_u1 :: MethodDecl-ldind_u1 = mdecl $ Ldind_u1+ldind_u1 = OpCode $ Ldind_u1  ldind_u2 :: MethodDecl-ldind_u2 = mdecl $ Ldind_u2+ldind_u2 = OpCode $ Ldind_u2  ldind_u4 :: MethodDecl-ldind_u4 = mdecl $ Ldind_u4+ldind_u4 = OpCode $ Ldind_u4  ldlen :: MethodDecl-ldlen = mdecl $ Ldlen+ldlen = OpCode $ Ldlen  ldloc :: Offset -> MethodDecl-ldloc 0 = mdecl $ Ldloc_0-ldloc 1 = mdecl $ Ldloc_1-ldloc 2 = mdecl $ Ldloc_2-ldloc 3 = mdecl $ Ldloc_3-ldloc x = mdecl $ Ldloc x+ldloc 0 = OpCode $ Ldloc_0+ldloc 1 = OpCode $ Ldloc_1+ldloc 2 = OpCode $ Ldloc_2+ldloc 3 = OpCode $ Ldloc_3+ldloc x = OpCode $ Ldloc x  ldlocN :: LocalName -> MethodDecl-ldlocN nm = mdecl $ LdlocN nm+ldlocN nm = OpCode $ LdlocN nm  ldloca :: Offset -> MethodDecl-ldloca = mdecl . Ldloca+ldloca = OpCode . Ldloca  ldlocaN :: LocalName -> MethodDecl-ldlocaN nm = mdecl $ LdlocaN nm+ldlocaN nm = OpCode $ LdlocaN nm  ldnull :: MethodDecl-ldnull = mdecl $ Ldnull+ldnull = OpCode $ Ldnull  ldsfld :: PrimitiveType -> AssemblyName -> TypeName -> FieldName -> MethodDecl-ldsfld p a t f = mdecl $ Ldsfld p a t f+ldsfld p a t f = OpCode $ Ldsfld p a t f  ldsflda :: PrimitiveType -> AssemblyName -> TypeName -> FieldName -> MethodDecl-ldsflda p a t f = mdecl $ Ldsflda p a t f+ldsflda p a t f = OpCode $ Ldsflda p a t f  ldstr :: String -> MethodDecl-ldstr = mdecl . Ldstr+ldstr = OpCode . Ldstr +ldtoken :: PrimitiveType -> MethodDecl+ldtoken = OpCode . Ldtoken+ mul :: MethodDecl-mul = mdecl $ Mul+mul = OpCode $ Mul  mul_ovf :: MethodDecl-mul_ovf = mdecl $ Mul_ovf+mul_ovf = OpCode $ Mul_ovf  mul_ovf_un :: MethodDecl-mul_ovf_un = mdecl $ Mul_ovf_un+mul_ovf_un = OpCode $ Mul_ovf_un  neg :: MethodDecl-neg = mdecl $ Neg+neg = OpCode $ Neg  newarr :: PrimitiveType -> MethodDecl-newarr t = mdecl $ Newarr t+newarr t = OpCode $ Newarr t  -- | Creates a new object. -- Note that this function assumes the constructor returns Void. -- If this is not the case, call the Newobj constructor manually. newobj :: AssemblyName -> TypeName -> [PrimitiveType] -> MethodDecl-newobj a t ps = mdecl $ Newobj Void a t ps+newobj a t ps = OpCode $ Newobj Void a t ps  nop :: MethodDecl-nop = mdecl $ Nop+nop = OpCode $ Nop  not :: MethodDecl-not = mdecl $ Not+not = OpCode $ Not  or :: MethodDecl-or = mdecl $ Or+or = OpCode $ Or  pop :: MethodDecl-pop = mdecl $ Pop+pop = OpCode $ Pop  rem :: MethodDecl-rem = mdecl $ Rem+rem = OpCode $ Rem  rem_un :: MethodDecl-rem_un = mdecl $ Rem_un+rem_un = OpCode $ Rem_un  ret :: MethodDecl-ret = mdecl $ Ret+ret = OpCode $ Ret  shl :: MethodDecl-shl = mdecl $ Shl+shl = OpCode $ Shl  shr :: MethodDecl-shr = mdecl $ Shr+shr = OpCode $ Shr  shr_un :: MethodDecl-shr_un = mdecl $ Shr_un+shr_un = OpCode $ Shr_un  stelem_i :: MethodDecl-stelem_i = mdecl $ Stelem_i+stelem_i = OpCode $ Stelem_i  stelem_i1 :: MethodDecl-stelem_i1 = mdecl $ Stelem_i1+stelem_i1 = OpCode $ Stelem_i1  stelem_i2 :: MethodDecl-stelem_i2 = mdecl $ Stelem_i2+stelem_i2 = OpCode $ Stelem_i2  stelem_i4 :: MethodDecl-stelem_i4 = mdecl $ Stelem_i4+stelem_i4 = OpCode $ Stelem_i4  stelem_i8 :: MethodDecl-stelem_i8 = mdecl $ Stelem_i8+stelem_i8 = OpCode $ Stelem_i8  stelem_r4 :: MethodDecl-stelem_r4 = mdecl $ Stelem_r4+stelem_r4 = OpCode $ Stelem_r4  stelem_r8 :: MethodDecl-stelem_r8 = mdecl $ Stelem_r8+stelem_r8 = OpCode $ Stelem_r8  stelem_ref :: MethodDecl-stelem_ref = mdecl $ Stelem_ref+stelem_ref = OpCode $ Stelem_ref  stfld :: PrimitiveType -> AssemblyName -> TypeName -> FieldName -> MethodDecl-stfld p a t f = mdecl $ Stfld p a t f+stfld p a t f = OpCode $ Stfld p a t f  stind_i :: MethodDecl-stind_i = mdecl $ Stind_i+stind_i = OpCode $ Stind_i  stind_i1 :: MethodDecl-stind_i1 = mdecl $ Stind_i1+stind_i1 = OpCode $ Stind_i1  stind_i2 :: MethodDecl-stind_i2 = mdecl $ Stind_i2+stind_i2 = OpCode $ Stind_i2  stind_i4 :: MethodDecl-stind_i4 = mdecl $ Stind_i4+stind_i4 = OpCode $ Stind_i4  stind_i8 :: MethodDecl-stind_i8 = mdecl $ Stind_i8+stind_i8 = OpCode $ Stind_i8  stind_r4 :: MethodDecl-stind_r4 = mdecl $ Stind_r4+stind_r4 = OpCode $ Stind_r4  stind_r8 :: MethodDecl-stind_r8 = mdecl $ Stind_r8+stind_r8 = OpCode $ Stind_r8  stind_ref :: MethodDecl-stind_ref = mdecl $ Stind_ref+stind_ref = OpCode $ Stind_ref  stloc :: Offset -> MethodDecl-stloc 0 = mdecl $ Stloc_0-stloc 1 = mdecl $ Stloc_1-stloc 2 = mdecl $ Stloc_2-stloc 3 = mdecl $ Stloc_3-stloc x = mdecl $ Stloc x+stloc 0 = OpCode $ Stloc_0+stloc 1 = OpCode $ Stloc_1+stloc 2 = OpCode $ Stloc_2+stloc 3 = OpCode $ Stloc_3+stloc x = OpCode $ Stloc x  stlocN :: LocalName -> MethodDecl-stlocN nm = mdecl $ StlocN nm+stlocN nm = OpCode $ StlocN nm  stsfld :: PrimitiveType -> AssemblyName -> TypeName -> FieldName -> MethodDecl-stsfld p a t f = mdecl $ Stsfld p a t f+stsfld p a t f = OpCode $ Stsfld p a t f  sub :: MethodDecl-sub = mdecl $ Sub+sub = OpCode $ Sub  sub_ovf :: MethodDecl-sub_ovf = mdecl $ Sub_ovf+sub_ovf = OpCode $ Sub_ovf  sub_ovf_un :: MethodDecl-sub_ovf_un = mdecl $ Sub_ovf_un+sub_ovf_un = OpCode $ Sub_ovf_un +switch :: [Label] -> MethodDecl+switch = OpCode . Switch+ tail :: MethodDecl-tail = mdecl $ Tail+tail = OpCode $ Tail  tailcall :: MethodDecl -> MethodDecl-tailcall (Instr (OpCode oc)) = Instr (OpCode (Tailcall oc))-tailcall _                   = error $ "Language.Cil.Build.tailcall: Can't tailcall supplied argument"+tailcall (OpCode oc) = OpCode (Tailcall oc)+tailcall _           = error $ "Language.Cil.Build.tailcall: Can't tailcall supplied argument"  throw :: MethodDecl-throw = mdecl $ Throw+throw = OpCode $ Throw  unaligned :: Alignment -> MethodDecl-unaligned a = mdecl $ Unaligned a+unaligned a = OpCode $ Unaligned a  unalignedPtr :: Alignment -> MethodDecl -> MethodDecl-unalignedPtr a (Instr (OpCode oc)) | supportsUnaligned oc = mdecl $ UnalignedPtr a oc-unalignedPtr _ _                                          = error $ "Language.Cil.Build.unalignedPtr: Supplied argument doesn't require alignment"+unalignedPtr a (OpCode oc) | supportsUnaligned oc = OpCode $ UnalignedPtr a oc+unalignedPtr _ _                                  = error $ "Language.Cil.Build.unalignedPtr: Supplied argument doesn't require alignment"  volatile :: MethodDecl-volatile = mdecl $ Volatile+volatile = OpCode $ Volatile  volatilePtr :: MethodDecl -> MethodDecl-volatilePtr (Instr (OpCode oc)) | supportsVolatile oc = mdecl $ VolatilePtr oc-volatilePtr _                                         = error $ "Language.Cil.Build.volatilePtr: Supplied argument cannot be marked volatile"+volatilePtr (OpCode oc) | supportsVolatile oc = OpCode $ VolatilePtr oc+volatilePtr _                                 = error $ "Language.Cil.Build.volatilePtr: Supplied argument cannot be marked volatile"  xor :: MethodDecl-xor = mdecl $ Xor+xor = OpCode $ Xor  -- Helper functions -mdecl :: OpCode -> MethodDecl-mdecl i = Instr $ OpCode i- supportsUnaligned :: OpCode -> Bool supportsUnaligned (VolatilePtr oc) = supportsPrefix oc supportsUnaligned oc               = supportsPrefix oc@@ -585,12 +613,9 @@  -- Convenient AST functions --- | Relabel a labelled mdecl with a new label.-label :: Label -> MethodDecl -> MethodDecl-label l (Instr (LabOpCode _ oc)) = Instr $ LabOpCode l oc-label l (Instr (OpCode oc))      = Instr $ LabOpCode l oc-label _ _                        = error $ "Language.Cil.Build.label: "-                                     ++ "Can't label non-Instrs."+-- | Relabel a labelled MethodDecl with a new label.+label :: Label -> MethodDecl+label l = Label l  comment :: String -> MethodDecl comment s = Comment s

@@ -99,16 +99,19 @@   pr (FaPublic)    = ("public" ++)   pr (FaPrivate)   = ("private" ++)   pr (FaAssembly)  = ("assembly" ++)+  pr (FaInitOnly)  = ("initonly" ++)  instance Pretty MethodDef where   pr (Constructor mas t ps ms) =       ident . (".method " ++)-    . prList mas . pr t . sp . (".ctor(" ++)+    . prList mas . pr t . sp . (ctorName ++)     . foldr (.) id (intersperse (", " ++) (map pr ps))     . (") cil managed\n" ++)     . ident . ("{\n" ++)     . foldr (\m s -> pr m . s) id ms     . ident . ("}\n" ++)+    where ctorName = if static then ".cctor(" else ".ctor("+          static   = MaStatic `elem` mas   pr (Method mas t n ps ms) =       ident . (".method " ++)     . prList mas@@ -138,13 +141,10 @@  instance Pretty MethodDecl where   pr (Directive d) = pr d-  pr (Instr i)     = pr i+  pr (Label l)     = ident . (l ++) . (":" ++) . nl+  pr (OpCode oc)   = ident . ident . pr oc . nl   pr (Comment s)   = ident . ident . ("// " ++) . (s ++) . nl -instance Pretty Instr where-  pr (OpCode oc)      = ident . ident . pr oc . nl-  pr (LabOpCode l oc) = ident . (l ++) . (":" ++) . nl-                              . ident . ident . pr oc . nl  instance Pretty Directive where   pr (EntryPoint)    = ident . ident . (".entrypoint" ++) . nl@@ -179,6 +179,7 @@                                . prCall a c m ps   pr (CallVirt t a c m ps) = ("callvirt instance " ++) . prsp t . sp                                . prCall a c m ps+  pr (Castclass t)         = ("castclass " ++) . pr t   pr (Ceq)                 = ("ceq" ++)   pr (Cgt)                 = ("cgt" ++)   pr (Ckfinite)            = ("ckfinite" ++)@@ -193,6 +194,8 @@   pr (Ldarg_2)             = ("ldarg.2 " ++)   pr (Ldarg_3)             = ("ldarg.3 " ++)   pr (LdargN nm)           = ("ldarg " ++) . prName nm+  pr (Ldarga x)            = ("ldarga " ++) . shows x+  pr (LdargaN nm)          = ("ldarga " ++) . prName nm   pr (Ldc_i4 x)            = ("ldc.i4 " ++) . shows x   pr (Ldc_i4_0)            = ("ldc.i4.0 " ++)    pr (Ldc_i4_1)            = ("ldc.i4.1 " ++) @@ -220,7 +223,7 @@   pr (Ldelem_ref)          = ("ldelem.ref " ++)   pr (Ldfld t a c f)       = ("ldfld " ++) . pr t . sp . prFld a c f   pr (Ldflda t a c f)      = ("ldflda " ++) . pr t . sp . prFld a c f-  pr (Ldftn t a c m ps)    = ("ldftn " ++) . pr t . sp . prCall a c m ps+  pr (Ldftn cc t a c m ps) = ("ldftn " ++) . prList cc . pr t . sp . prCall a c m ps   pr (Ldind_i)             = ("ldind.i " ++)   pr (Ldind_i1)            = ("ldind.i1 " ++)   pr (Ldind_i2)            = ("ldind.i2 " ++)@@ -245,6 +248,7 @@   pr (Ldsfld t a c f)      = ("ldsfld " ++) . pr t . sp . prFld a c f   pr (Ldsflda t a c f)     = ("ldsflda " ++) . pr t . sp . prFld a c f   pr (Ldstr s)             = ("ldstr " ++) . shows s+  pr (Ldtoken t)           = ("ldtoken " ++) . prTypeToken t   pr (Mul)                 = ("mul" ++)   pr (Mul_ovf)             = ("mul.ovf" ++)   pr (Mul_ovf_un)          = ("mul.ovf.un" ++)@@ -287,12 +291,14 @@   pr (Sub)                 = ("sub" ++)   pr (Sub_ovf)             = ("sub.ovf" ++)   pr (Sub_ovf_un)          = ("sub.ovf.un" ++)+  pr (Switch labels)       = (("switch (" ++ intercalate ", " labels ++ ")") ++)   pr (Tail)                = ("tail." ++)   pr (Tailcall opcode)     = ("tail. " ++) . pr opcode   pr (Throw)               = ("throw" ++)   pr (Unaligned a)         = ("unaligned. " ++) . pr a   pr (UnalignedPtr a opcode)  = ("unaligned. " ++) . pr a . sp . pr opcode   pr (Unbox t)             = ("unbox " ++) . pr t+  pr (Unbox_any t)         = ("unbox.any " ++) . pr t   pr (Volatile)            = ("volatile." ++)   pr (VolatilePtr opcode)  = ("volatile. " ++) . pr opcode   pr (Xor)                 = ("xor" ++)@@ -330,9 +336,20 @@   . foldr (.) id (intersperse (", " ++) (map pr ps))   . (")" ++) +prTypeToken :: PrimitiveType -> ShowS+prTypeToken (ValueType a c)     = prAssembly a . prName c+prTypeToken (ReferenceType a c) = prAssembly a . prName c+prTypeToken t = pr t+ prAssembly :: DottedName -> ShowS prAssembly a = bool (("[" ++) . prName a . ("]" ++)) id (a == "") +prGenericTypeName :: TypeName -> [a] -> (a -> ShowS) -> ShowS+prGenericTypeName n args prArg =+    prName n+  . ("`" ++) . shows (length args)+  . ("<" ++) . foldr (.) id (intersperse ("," ++) (map prArg args)) . (">" ++)+ instance Pretty PrimitiveType where   pr Void                = ("void" ++)    pr Bool                = ("bool" ++)@@ -341,16 +358,17 @@   pr Int32               = ("int32" ++)   pr Int64               = ("int64" ++)   pr Float32             = ("float32" ++)-  pr Double64            = ("double64" ++)+  pr Double64            = ("float64" ++)   pr IntPtr              = ("native int" ++)   pr String              = ("string" ++)   pr Object              = ("object" ++)   pr (ValueType a c)     = ("valuetype " ++) . prAssembly a . prName c   pr (ReferenceType a c) = ("class " ++ ) . prAssembly a . prName c-  pr (GenericReferenceType a c gs) = prAssembly a . prName c . ("`" ++) . shows (length gs)-                                       . ("<" ++) . foldr (.) id (intersperse ("," ++) (map ((("!" ++) .) . prName) gs)) . (">" ++)+  pr (GenericReferenceType a c gs)         = prAssembly a . prGenericTypeName c gs ((("!" ++) .) . prName)+  pr (GenericReferenceTypeInstance a c ts) = ("class " ++) . prAssembly a . prGenericTypeName c ts pr   pr (GenericType x)     = ("!" ++) . shows x   pr (ByRef pt)          = pr pt . ("&" ++)+  pr (Array et)          = pr et . ("[]" ++)  instance Pretty Alignment where   pr ByteAligned         = ("1" ++)

@@ -30,7 +30,6 @@   , Parameter     (..)   , ParamAttr     (..)   , MethodDecl    (..)-  , Instr         (..)   , Directive     (..)   , Local         (..)   , Label@@ -124,6 +123,7 @@   | FaPublic   | FaPrivate   | FaAssembly+  | FaInitOnly   deriving Show  -- | Primitive types in CIL.@@ -142,9 +142,11 @@   | ValueType AssemblyName TypeName   | ReferenceType AssemblyName TypeName   | GenericReferenceType AssemblyName TypeName [GenParamName]+  | GenericReferenceTypeInstance AssemblyName TypeName [PrimitiveType]   | ByRef PrimitiveType   | GenericType Offset-  deriving Show+  | Array PrimitiveType+  deriving (Eq, Ord, Show)  -- | A specification of pointer alignment. data Alignment@@ -167,7 +169,7 @@   | MaAssembly   | MaVirtual   | MaHidebysig-  deriving Show+  deriving (Show, Eq)  -- | A formal parameter to a method. data Parameter@@ -184,8 +186,9 @@ -- | Method declarations, i.e. the body of a method. data MethodDecl   = Directive Directive-  | Instr Instr-  | Comment String+  | Label     Label+  | OpCode    OpCode+  | Comment   String   deriving Show  -- | Directive meta data for method definitions.@@ -200,13 +203,6 @@   = Local PrimitiveType LocalName   deriving Show --- | Single instruction in method definition.--- Either an OpCode or a labelled OpCode.-data Instr-  = LabOpCode Label OpCode-  | OpCode    OpCode-  deriving Show- -- | CIL OpCodes inside a method definition. -- See <http://msdn.microsoft.com/en-us/library/system.reflection.emit.opcodes_fields.aspx> -- for a more complete list with documentation.@@ -240,6 +236,7 @@       , methodName   :: MethodName      -- ^ Name of the method.       , paramTypes   :: [PrimitiveType] -- ^ Types of the formal parameters of the method.       } -- ^ Pops /n/ values, calls specified virtual method, pushes return value. (where /n/ is the number of formal parameters of the method).+  | Castclass PrimitiveType -- ^ Pops 1 value, attempts to cast it to the specified type. If this succeeds, pushes the cast value. Otherwise throws an InvalidCastException.   | Ceq                -- ^ Pops 2 values, if they are equal, pushes 1 to stack; otherwise, pushes 0.   | Cgt                -- ^ Pops 2 values and compares them.   | Ckfinite           -- ^ Pops a float or double. Throws an ArithmeticException if the popped value is NaN or +/- infinity. Pushes the popped value.@@ -254,6 +251,8 @@   | Ldarg_2            -- ^ Loads 2th argument to current method onto stack.   | Ldarg_3            -- ^ Loads 3th argument to current method onto stack.   | LdargN DottedName  -- ^ Loads named argument to current method onto stack.+  | Ldarga Offset      -- ^ Loads address of the /n/-th argument to current method onto stack.+  | LdargaN DottedName -- ^ Loads address of the named argument to current method onto stack.   | Ldc_i4 Integer     -- ^ Loads the supplied 32-bit integer onto the stack.   | Ldc_i4_0           -- ^ Loads the value 0 onto the stack.   | Ldc_i4_1           -- ^ Loads the value 1 onto the stack.@@ -295,7 +294,8 @@       , fieldName    :: FieldName      -- ^ Name of the field.       } -- ^ Pops object reference, find address of specified field on the object, pushes address to the stack.   | Ldftn -      { returnType   :: PrimitiveType    -- ^ Return type of the method.+      { callConv     :: [CallConv]       -- ^ Method is associated with class or instance.+      , returnType   :: PrimitiveType    -- ^ Return type of the method.       , assemblyName :: AssemblyName     -- ^ Name of the assembly where the method resides.       , typeName     :: TypeName         -- ^ Name of the type of which the method is a member.       , methodName   :: MethodName       -- ^ Name of the method.@@ -335,6 +335,7 @@       , fieldName    :: FieldName      -- ^ Name of the field.       } -- ^ Pops type reference, find address of specified field on the type, pushes address to the stack.   | Ldstr String       -- ^ Pushes an object reference to the specified string constant.+  | Ldtoken PrimitiveType -- ^ Pushes the RuntimeTypeHandle of the specified type.   | Mul                -- ^ Pops 2 values, multiplies the values, pushes result.   | Mul_ovf            -- ^ Pops 2 values, multiplies the values with a signed overflow check, pushes result.   | Mul_ovf_un         -- ^ Pops 2 values, multiplies the values with an unsigned overflow check, pushes result.@@ -393,12 +394,14 @@   | Sub                -- ^ Pops 2 values, subtracts second value from the first value, pushes result.   | Sub_ovf            -- ^ Pops 2 values, subtracts second value from the first value with a signed overflow check, pushes result.   | Sub_ovf_un         -- ^ Pops 2 values, subtracts second value from the first value with an unsigned overflow check, pushes result.+  | Switch [Label]     -- ^ Pops an unsigned integer value and transfers control to label with matching index.   | Tail               -- ^ Performs subsequent call as a tail call, by replacing current stack frame with callee stack frame.   | Tailcall OpCode    -- ^ Performs provided call as a tail call, by replacing current stack frame with callee stack frame.   | Throw              -- ^ Pops an object reference from the stack and throws it as an exception.   | Unaligned Alignment -- ^ Performs subsequent load or store operation under a weaker-than-usual alignment precondition.   | UnalignedPtr  Alignment OpCode -- ^ Performs provided load or store operation under a weaker-than-usual alignment precondition.   | Unbox PrimitiveType  -- ^ Pops 1 value, unboxes object reference, pushes value type.+  | Unbox_any PrimitiveType  -- ^ Pops 1 value, unboxes and loads value, equivalent to unbox followed by ldobj   | Volatile           -- ^ Marks subsequent pointer reference as volatile, i.e. the value it points at can be modified from another thread.   | VolatilePtr OpCode -- ^ Marks provided pointer reference as volatile, i.e. the value it points at can be modified from another thread.   | Xor                -- ^ Pops 2 values, do bitwise XOR between the values, pushes result.