GitLab will be upgraded on 30 Jan 2023 from 2.00 pm (AEDT) to 3.00 pm (AEDT). During the update, GitLab and Mattermost services will not be available. If you have any concerns with this, please talk to us at N110 (b) CSIT building.

AST.hs 25.2 KB
Newer Older
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
-- |
-- Module      :  Mu.AST
-- Copyright   :  Author 2011-2012
-- License     :  BSD3
--
-- Maintainer  :  email@something.com
-- Stability   :  experimental
-- Portability :  unknown
--
-- Description
--

{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}
16
{-# LANGUAGE DeriveGeneric #-}
17
{-# LANGUAGE NoImplicitPrelude #-}
18

19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
module Mu.AST (
    HasName (..)
  , Name (..)
  , SignatureName (..)
  , TypedefName (..)
  , FunctionName (..)
  , FunctionVerName (..)
  , ConstantName (..)
  , GlobalCellName (..)
  , BasicBlockName (..)
  , InstructionName (..)
  , ExposeName (..)
  , CookieName (..)
  , VarName (..)
  , Version (..)
  , Bundle (..)
  , Definition (..)
  , ConstConstructor (..)
  , CallConvention (..)
  , Type (..)
  , ExceptionClause (..)
  , WPExceptionClause (..)
  , KeepAliveClause (..)
  , DestinationClause (..)
  , Flag (..)
  , BinaryOp (..)
  , CompareOp (..)
  , ConvertOp (..)
  , AtomicRMWOp (..)
  , MemoryOrder (..)
  , Expression (..)
  , CurStackClause (..)
  , NewStackClause (..)
  , Assigned (..)
  , BasicBlock (..)
  , versionedName
  , dot
56
  , (%)
57
58
  , CommInst (..)
  ) where
59

60
61
import Prelude hiding (EQ)

nathyong's avatar
nathyong committed
62
import Data.Monoid ((<>))
63
import Data.Binary (Binary)
64
import Data.ByteString.Char8 (ByteString)
65
import Data.String (IsString, fromString)
66
import GHC.Generics (Generic)
67
68
69
70

import Text.Printf (printf)
import Data.List (intersperse, concat, map)

71
72
import Mu.AST.CommInst

73
74
75
76
77
78
79
80
-------------------------------------------------- * Named things

-- For internal use only, hence the underscore_naming.
type Underlying_Name_Type = String

-- | A universal class for the various things that newtype off 'Name'.
class HasName a where
    nameOf :: a -> Underlying_Name_Type 
81
82
    nameOf = nameOf . toName

nathyong's avatar
nathyong committed
83
    toName :: a -> Name
84
85

newtype Name = Name Underlying_Name_Type 
86
87
88
    deriving (IsString, Eq, Ord, Generic)

instance Binary Name
89
90
91
92
93
94

instance Show Name where
    show (Name n) = n

instance HasName Name where
    nameOf (Name n) = n
nathyong's avatar
nathyong committed
95
    toName = id
96
97
98

-- A little bit disgusting, but it gives us type safety where previously we had
-- none.
99
100
101
102
103
104
newtype SignatureName = SignatureName Name
    deriving (HasName, Eq, Ord, Show, IsString, Generic)
newtype TypedefName = TypedefName Name
    deriving (HasName, Eq, Ord, Show, IsString, Generic)
newtype FunctionName = FunctionName Name
    deriving (HasName, Eq, Ord, Show, IsString, Generic)
nathyong's avatar
nathyong committed
105
106
newtype FunctionVerName = FunctionVerName Name
    deriving (HasName, Eq, Ord, Show, IsString, Generic)
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
newtype ConstantName = ConstantName Name
    deriving (HasName, Eq, Ord, Show, IsString, Generic)
newtype GlobalCellName = GlobalCellName Name
    deriving (HasName, Eq, Ord, Show, IsString, Generic)
newtype BasicBlockName = BasicBlockName Name
    deriving (HasName, Eq, Ord, Show, IsString, Generic)
newtype InstructionName = InstructionName Name
    deriving (HasName, Eq, Ord, Show, IsString, Generic)
newtype ExposeName = ExposeName Name
    deriving (HasName, Eq, Ord, Show, IsString, Generic)
newtype CookieName = CookieName Name
    deriving (HasName, Eq, Ord, Show, IsString, Generic)
newtype VarName = VarName Name
    deriving (HasName, Eq, Ord, Show, IsString, Generic)

instance Binary SignatureName
instance Binary TypedefName
instance Binary FunctionName
nathyong's avatar
nathyong committed
125
instance Binary FunctionVerName
126
127
128
129
130
131
132
133
instance Binary ConstantName
instance Binary GlobalCellName
instance Binary BasicBlockName
instance Binary InstructionName
instance Binary ExposeName
instance Binary CookieName
instance Binary VarName

134
newtype Version = Version Underlying_Name_Type deriving (Generic)
135
136

instance Binary Version
137

138
139
140
instance Show Version where
    show (Version vn) = vn

nathyong's avatar
nathyong committed
141
142
143
versionedName :: FunctionName -> Version -> FunctionVerName
versionedName fn (Version vn) = FunctionVerName $ Name $ nameOf fn <> "." <> vn

144
-- | Create a new name for a Mu thing inside some other scope.
nathyong's avatar
nathyong committed
145
146
dot :: (HasName a, IsString b) => a -> Underlying_Name_Type -> b
dot a sub = fromString $ nameOf a <> "." <> sub
147

148
149
150
151
152
153
-- | Infix version of 'dot'.
--
-- Possibly a bad idea to use.
(%) :: (HasName a, IsString b) => a -> Underlying_Name_Type -> b
(%) = dot

154
155
-------------------------------------------------- * Intermediate Representation

156
157
158
159
-- $ir
-- See <https://gitlab.anu.edu.au/mu/mu-spec/blob/master/ir.rst>

-- | A representation of Mu Bundles.
160
newtype Bundle = Bundle { unBundle :: [Definition] }
161
162
163
    deriving (Monoid, Generic)

instance Binary Bundle
164
165
166

data Definition
    = TypeDefinition TypedefName Type
167
168
    | SignatureDefinition SignatureName [TypedefName] [TypedefName]
    | FunctionDefinition FunctionName Version SignatureName BasicBlock [BasicBlock]
169
170
171
    | Constant ConstantName TypedefName ConstConstructor
    | GlobalCell GlobalCellName TypedefName
    | ExposedFunction ExposeName FunctionName CallConvention CookieName
172
173
174
    deriving (Generic)

instance Binary Definition
175

nathyong's avatar
nathyong committed
176
177
178
179
180
181
182
183
184
185
186
instance HasName Definition where
    nameOf defn = case defn of
        TypeDefinition name _ -> nameOf name
        SignatureDefinition name _ _ -> nameOf name
        FunctionDefinition name _ _ _ _ -> nameOf name
        Constant name _ _ -> nameOf name
        GlobalCell name _ -> nameOf name
        ExposedFunction name _ _ _ -> nameOf name

    toName = Name . nameOf

187
data ConstConstructor = IntCtor Integer
188
189
                      | FloatCtor Float
                      | DoubleCtor Double
190
                      | ListCtor [ConstantName]
191
192
                      | NullCtor
                      | ExternCtor ByteString
193
194
195
                      deriving (Generic)

instance Binary ConstConstructor
196
197
198
199
200

-- | Represent the Mu Calling convention
data CallConvention
    = MuCallConvention -- ^ Mu represents the default calling convention, CCall
    | ForeignCallConvention String -- ^ Extra conventions can be invoked using the foreign Convention
201
202
203
    deriving (Eq, Show, Generic)

instance Binary CallConvention
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241

-- | Represent the Mu IR native types.
data Type
    = MuInt { intLen :: Int}
      -- ^ Integers of variable sizes (1, 8, 16, 32 & 64 bits)
    | MuFloat
      -- ^ IEEE single length floating point
    | MuDouble
      -- ^ IEEE double length floating point
    | Ref { refType :: TypedefName}
      -- ^ A reference to a Mu TypedefName
    | IRef { irefType :: TypedefName}
      -- ^ An internal refernce to a Mu TypedefName
    | WeakRef { weakRefType :: TypedefName}
      -- ^ A weak refernce to a Mu TypedefName
    | UPtr { uptrType :: TypedefName}
      -- ^ A pointer to a Mu TypedefName
    | Struct { structTypes :: [TypedefName]}
      -- ^ A struct of multiple Mu Types
    | Array { arrayType :: TypedefName
           ,  arrayLen :: Int}
      -- ^ An array of a set number of Mu Types
    | Hybrid { hybridTypes :: [TypedefName]
            ,  hybridType :: TypedefName}
      -- ^ A hybrid with a set 'header' of Mu types, then a variable
      -- number of A single Mu TypedefName
    | Void
    | ThreadRef
    | StackRef
    | FrameCursorRef
    | TagRef64
    | Vector { vectorType :: TypedefName
            ,  vectorLen :: Int}
      -- ^ Vector of multiple Mu types
    | FuncRef { funcRefSig :: SignatureName}
      -- ^ Function ref to a function signature
    | UFuncPtr { ufuncPtrSig :: SignatureName}
      -- ^ Function pointer to a function signature
242
243
244
    deriving (Eq, Ord, Generic)

instance Binary Type
245
246
247
248
249

-- | Represents an Exception Clause which are appended to certain instructions
data ExceptionClause = ExceptionClause
    { exceptionNor :: DestinationClause -- ^ The destination to go to if normal execution happens
    , exceptionExc :: DestinationClause -- ^ The exceptional destination
250
251
    } deriving (Eq, Show, Generic)
instance Binary ExceptionClause
252
253
254
255

-- | WP Exceptions are used for Watch Points
newtype WPExceptionClause = WPExceptionClause
    { wpExceptionDest :: DestinationClause
256
257
    } deriving (Eq, Show, Generic)
instance Binary WPExceptionClause
258
259
260
261

-- | Keep Alive clause used to keep certain variables alive outside their scope
newtype KeepAliveClause = KeepAlive
    { keepAliveVars :: [VarName]
262
263
    } deriving (Eq, Show, Generic)
instance Binary KeepAliveClause
264
265
266

-- | Destination clause, the call to move to a basic block e.g. %cont(%a)
data DestinationClause = DestinationClause
267
    { destClauseDestination :: BasicBlockName
268
    , destClauseArgList :: [VarName]
269
270
    } deriving (Eq, Show, Generic)
instance Binary DestinationClause
271
272
273
274

-- | Flags for Common Instructions and CCall, pp $ Flag "DEFAULT" == "#DEFAULT"
newtype Flag = Flag
    { flagValue :: String
275
276
    } deriving (Generic)
instance Binary Flag
277
278

-- | Binary Ops as defined by the Mu Spec
279
-- | Binary Ops all use the same arguments, so these flags represent precisely which binary operation to display
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
data BinaryOp
    = Add
    | Sub
    | Mul
    | SDiv
    | SRem
    | UDiv
    | URem
    | Shl
    | LShr
    | AShr
    | And
    | Or
    | Xor
    | FAdd
    | FSub
    | FMul
    | FDiv
    | FRem
299
    deriving (Eq, Ord, Show, Generic)
300
instance Binary BinaryOp
301

302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
instance Enum BinaryOp where
    fromEnum op = case op of
        Add  -> 0x01
        Sub  -> 0x02
        Mul  -> 0x03
        SDiv -> 0x04
        SRem -> 0x05
        UDiv -> 0x06
        URem -> 0x07
        Shl  -> 0x08
        LShr -> 0x09
        AShr -> 0x0a
        And  -> 0x0b
        Or   -> 0x0c
        Xor  -> 0x0d
        FAdd -> 0xb0
        FSub -> 0xb1
        FMul -> 0xb2
        FDiv -> 0xb3
        FRem -> 0xb4
        
    toEnum val = case val of
        0x01 -> And
        0x02 -> Sub
        0x03 -> Mul
        0x04 -> SDiv
        0x05 -> SRem
        0x06 -> UDiv
        0x07 -> URem
        0x08 -> Shl
        0x09 -> LShr
        0x0a -> AShr
        0x0b -> And
        0x0c -> Or
        0x0d -> Xor
        0xb0 -> FAdd
        0xb1 -> FSub
        0xb2 -> FMul
        0xb3 -> FDiv
        0xb4 -> FRem
        _    -> error $ (show val) ++ " is not a valid BinaryOp"
        

345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
-- | Compare Ops as defined by the Mu Spec
-- | See Binary Ops for more detail
data CompareOp
    = EQ
    | NE
    | SGE
    | SLE
    | SGT
    | SLT
    | UGE
    | UGT
    | ULE
    | ULT
    | FFALSE
    | FTRUE
    | FOEQ
    | FOGT
    | FOGE
    | FOLT
    | FOLE
    | FONE
    | FORD
    | FUEQ
    | FUGT
    | FUGE
    | FULT
    | FULE
    | FUNE
    | FUNO
374
    deriving (Eq, Ord, Show, Generic)
375
instance Binary CompareOp
376

377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
instance Enum CompareOp where
    fromEnum op = case op of
        EQ     -> 0x20
        NE     -> 0x21
        SGE    -> 0x22
        SGT    -> 0x23
        SLE    -> 0x24
        SLT    -> 0x25
        UGE    -> 0x26
        UGT    -> 0x27
        ULE    -> 0x28
        ULT    -> 0x29
        FFALSE -> 0xC0
        FTRUE  -> 0xC1
        FUNO   -> 0xC2
        FUEQ   -> 0xC3
        FUNE   -> 0xC4
        FUGT   -> 0xC5
        FUGE   -> 0xC6
        FULT   -> 0xC7
        FULE   -> 0xC8
        FORD   -> 0xC9
        FOEQ   -> 0xCA
        FONE   -> 0xCB
        FOGT   -> 0xCC
        FOGE   -> 0xCD
        FOLT   -> 0xCE
        FOLE   -> 0xCF
        
    toEnum val = case val of
        0x20 -> EQ
        0x21 -> NE
        0x22 -> SGE
        0x23 -> SGT
        0x24 -> SLE
        0x25 -> SLT
        0x26 -> UGE
        0x27 -> UGT
        0x28 -> ULE
        0x29 -> ULT
        0xC0 -> FFALSE
        0xC1 -> FTRUE
        0xC2 -> FUNO
        0xC3 -> FUEQ
        0xC4 -> FUNE
        0xC5 -> FUGT
        0xC6 -> FUGE
        0xC7 -> FULT
        0xC8 -> FULE
        0xC9 -> FORD
        0xCA -> FOEQ
        0xCB -> FONE
        0xCC -> FOGT
        0xCD -> FOGE
        0xCE -> FOLT
        0xCF -> FOLE
        _    -> error $ (show val) ++ " is not a valid CompareOp"

435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
-- | Convert Ops as defined by the Mu Spec
-- | See Binary Ops for more detail
data ConvertOp
    = TRUNC
    | ZEXT
    | SEXT
    | FPTRUNC
    | FPEXT
    | FPTOUI
    | FPTOSI
    | UITOFP
    | SITOFP
    | BITCAST
    | REFCAST
    | PTRCAST
450
    deriving (Eq, Ord, Show, Generic)
451
instance Binary ConvertOp
452

453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
instance Enum ConvertOp where
    fromEnum op = case op of
        TRUNC -> 0x30
        ZEXT -> 0x31
        SEXT -> 0x32
        FPTRUNC -> 0x33
        FPEXT -> 0x34
        FPTOUI -> 0x35
        FPTOSI -> 0x36
        UITOFP -> 0x37
        SITOFP -> 0x38
        BITCAST -> 0x39
        REFCAST -> 0x3A
        PTRCAST -> 0x3B
        
    toEnum val = case val of
        0x30 -> TRUNC
        0x31 -> ZEXT
        0x32 -> SEXT
        0x33 -> FPTRUNC
        0x34 -> FPEXT
        0x35 -> FPTOUI
        0x36 -> FPTOSI
        0x37 -> UITOFP
        0x38 -> SITOFP
        0x39 -> BITCAST
        0x3a -> REFCAST
        0x3b -> PTRCAST
        _    -> error $ (show val) ++ " is not a valid ConvertOp"

483
484
485
486
487
488
489
490
491
492
493
494
495
496
-- | Atomic RMW Ops as  defined by the mu spec
-- | See Binary Ops for more detail
data AtomicRMWOp
    = XCHG
    | ADD
    | SUB
    | AND
    | NAND
    | OR
    | XOR
    | MAX
    | MIN
    | UMAX
    | UMIN
497
498
499
    deriving (Eq, Ord, Enum, Show, Generic)

instance Binary AtomicRMWOp
500
501
502
503
504
505
506
507
508
509

-- | Memory Orders ad defined by the Mu Spec
data MemoryOrder
    = NOT_ATOMIC
    | RELAXED
    | CONSUME
    | ACQUIRE
    | RELEASE
    | ACQ_REL
    | SEQ_CST
510
511
512
    deriving (Eq, Ord, Enum, Show, Generic)

instance Binary MemoryOrder
513
514
515
516

-- | Expressions define all the operations which can be performed on Mu Data. This includes terminal instructions.
data Expression
    = BinaryOperation
517
518
      { -- | The operation to be performed (Add, sub ...)
         binOp :: BinaryOp
519
520
521
522
523
524
525
526
527
         -- | The type of both parameters (they must be the same type)
      ,  binType :: TypedefName
         -- | The first parameter
      ,  binV1 :: VarName
         -- | The second parameter
      ,  binV2 :: VarName
         -- | The optional exception clause
      ,  execClause :: Maybe ExceptionClause}
    | CompareOperation
528
529
      { -- | The compare operation, {EQ, SLE ... }
         cmpOp :: CompareOp
530
531
532
533
534
535
536
         -- | Type of both operands
      ,  cmpType :: TypedefName
         -- | first parameter
      ,  cmpV1 :: VarName
         -- | second parameter
      ,  cmpV2 :: VarName}
    | ConvertOperation
537
538
      { -- | Operation to be performed {TRUNC, SEXT ...}
         convOp :: ConvertOp
539
540
541
542
543
         -- | The source type, the type to be converted from
      ,  convTypeSrc :: TypedefName
         -- | The destination type, the type to be converted to
      ,  convTypeDest :: TypedefName
         -- | Variable to be converted
544
      ,  convV :: VarName}
545
    | AtomicRMWOperation
546
547
      {  -- | Bool indicates if Loc is a pointer
         aRMWIsPtr :: Bool
548
549
550
551
552
553
554
555
556
557
558
559
560
         -- | The memory order for the operation
      ,  aRMWMemOrd :: MemoryOrder
         -- | The operation to be performed
      ,  aRMWOp :: AtomicRMWOp
         -- | The type of loc
      ,  aRMWType :: TypedefName
         -- | The memory location/address to access.
      ,  aRMWLoc :: VarName
         -- | The literal to be used
      ,  aRMWOpnd :: VarName
         -- | The optional Exception clause
      ,  aRMWExecClause :: Maybe ExceptionClause}
    | CmpXchg
561
562
      {  -- | Bool indicating if loc is a pointer
         cmpXchgIsPtr :: Bool
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
         -- | Bool indicating if operation is weak
      ,  cmpXchgIsWeak :: Bool
         -- | Memory order for operation success
      ,  cmpXchgMemOrdSucc :: MemoryOrder
         -- | Memory order for operation failure
      ,  cmpXchgMemOrdFail :: MemoryOrder
         -- | The type of the operation. Must be EQ comparable
      ,  cmpXchgType :: TypedefName
         -- | variable of IRef<T> or UPtr<T>. The memory loc/addr to access
      ,  cmpXchgLoc :: VarName
         -- | Strong Variant represents expected value in memory
      ,  cmpXchgExpect :: VarName
         -- | Strong Variant represents Desired value in memory
      ,  cmpXchgDesired :: VarName
         -- | Optional exception clause
      ,  cmpXchgExecClause :: Maybe ExceptionClause}
    | Fence
580
581
      {  -- | Memory order for fence operation
         fenceMemOrd :: MemoryOrder}
582
    | New
583
584
      {  -- | Type to allocate from heap
         newType :: TypedefName
585
586
587
         -- | exception clause if operation fails
      ,  newExecClause :: Maybe ExceptionClause}
    | NewHybrid
588
589
      {  -- | Hybrid type to alloate from heap
         newHybridType :: TypedefName
590
591
592
593
594
595
596
         -- | Length of hybrid type (must be int)
      ,  newHybridLenType :: TypedefName
         -- | Length of hybrid
      ,  newHybridLen :: VarName
         -- | Exception clause if operation fails
      ,  newHybridExecClause :: Maybe ExceptionClause}
    | Alloca
597
598
      {  -- | Type to allocate
         allocaType :: TypedefName
599
600
601
         -- | Exception clause if operation fails
      ,  allocaExecClause :: Maybe ExceptionClause}
    | AllocaHybrid
602
603
      {  -- | Hybrid Type to allocate
         allocaHybridType :: TypedefName
604
605
606
607
608
609
610
         -- | Length of hybrid type (must be int)
      ,  allocaHybridLenType :: TypedefName
         -- | Length of hybrid
      ,  allocaHybridLen :: VarName
         -- | Exception clause if operation fails
      ,  allocaHybridExecClause :: Maybe ExceptionClause}
    | Return
611
612
      {  -- | Values to return (if any)
         returnValues :: [VarName]}
613
    | Throw
614
615
      {  -- | exceptional variable tor throw
         throwException :: VarName}
616
    | Call
617
618
      {  -- | Signature of Mu Function to call
         callSignature :: SignatureName
619
620
621
622
623
624
625
626
627
         -- | Variable of type funcref<@sig>
      ,  callCallee :: VarName
         -- | Arguments to pass to function
      ,  callArgList :: [VarName]
         -- | optional exception clause
      ,  callExceptionClause :: Maybe ExceptionClause
         -- | Optional keep alive clause
      ,  callKeepAliveClause :: Maybe KeepAliveClause}
    | CCall
628
629
      {  -- | Calling convention to follow (Mu or Other)
         ccallCallConv :: CallConvention
630
631
632
633
634
635
636
637
638
639
640
641
642
         -- | type of callee (ufuncptr<@sig>)
      ,  ccallType :: TypedefName
         -- | Signature of callee
      ,  ccallSig :: SignatureName
         -- | address of function to call. (.const @callee = ufuncptr<@sig> 0xdeadbeef)
      ,  ccallCallee :: VarName
         -- | Arguments to pass to function
      ,  ccallArgList :: [VarName]
         -- | optional exception clause
      ,  ccallExceptionClause :: Maybe ExceptionClause
         -- | optional keep alive clause
      ,  ccallKeepAliveClause :: Maybe KeepAliveClause}
    | TailCall
643
644
      {  -- | signature of function to call
         tailCallSignature :: SignatureName
645
646
647
648
649
         -- | function to call
      ,  tailCallCallee :: VarName
         -- | arguments to pass
      ,  tailCallArgList :: [VarName]}
    | Branch1
650
651
      {  -- | BasicBlock to branch to
         branch1Destination :: DestinationClause}
652
    | Branch2
653
654
      {  -- | Variable of type int<1>, condition on which to branch
         branch2Cond :: VarName
655
656
657
658
659
         -- | Branch if condition is true
      ,  branch2BranchTrue :: DestinationClause
         -- | Branch if condition is false
      ,  branch2BranchFalse :: DestinationClause}
    | WatchPoint
660
661
      {  -- | name of watchpoint
         watchpointname :: VarName
662
663
664
665
666
667
668
669
670
671
672
673
674
         -- | id of watchpoint
      ,  watchpointId :: Int
         -- | The types of the return values
      ,  watchpointTypes :: [TypedefName]
         -- | destination before watchpoint is enabled
      ,  watchpointdis :: DestinationClause
         -- | destination after watchpoint is enabled
      ,  watchpointena :: DestinationClause
         -- | optional exception clause for after watchpoint is enabled
      ,  watchpointWpExec :: Maybe WPExceptionClause
         -- | optional keep alive clause for after watchpoint is enabled
      ,  watchpointKeepAlive :: Maybe KeepAliveClause}
    | Trap
675
676
      {  -- | name of trap
         trapName :: VarName
677
678
679
680
681
682
683
         -- | the types of the values to return
      ,  trapTypes :: [TypedefName]
         -- | optional exception clause
      ,  trapExceptionClause :: Maybe ExceptionClause
         -- | optinoal keep alive clause
      ,  trapKeepAlive :: Maybe KeepAliveClause}
    | WPBranch
684
685
      {  -- | watchpoint id
         wpBranchId :: Int
686
687
688
689
690
         -- | destination to jump to if watchpoint is enabled
      ,  wpBranchDis :: DestinationClause
         -- | destination to jump to if watchpoint is disabled
      ,  wpBranchEna :: DestinationClause}
    | Switch
691
692
      {  -- | type of value to switch on
         switchType :: TypedefName
693
694
695
696
697
698
699
         -- | value to switch on
      ,  switchOpnd :: VarName
         -- | default destination (if all others fail)
      ,  switchDefault :: DestinationClause
         -- | list of (condition, destination) pairs
      ,  switchBlocks :: [(VarName, DestinationClause)]}
    | SwapStack
700
701
      {  -- | variable of type stackref (stack to swap to)
         swapStackSwapee :: VarName
702
703
704
705
706
707
708
709
710
         -- | cur stack clause to use
      ,  swapStackCurStackClause :: CurStackClause
         -- | new stack clause to use
      ,  swapStackNewStackClause :: NewStackClause
         -- | optional exception clause
      ,  swapStackExecClause :: Maybe ExceptionClause
         -- | optional keep alive clause
      ,  swapStackKeepAliveClause :: Maybe KeepAliveClause}
    | NewThread
711
712
      {  -- | variable of type stackref (stack to bind thread to)
         newThreadStack :: VarName
713
714
715
716
717
         -- | new stack clause to use
      ,  newThreadStackClause :: NewStackClause
         -- | optional exception clause to use
      ,  newThreadExceptionClause :: Maybe ExceptionClause}
    | Comminst
718
719
      {  -- | operation code of the common instruction
         comminstInst :: CommInst
720
         -- | optional flags to pass
721
      ,  comminstFlags :: [Flag]
722
         -- | types (if any) of the arguments to pass to comminst
723
      ,  comminstTypes :: [TypedefName]
724
725
         -- | signatures (if any) to pass to the comminst
      ,  comminstSigs :: [SignatureName]
726
         -- | arguments (if any) to pass to the comminst
727
      ,  comminstArgs :: [VarName]
728
729
730
731
732
         -- | optional exception clause
      ,  comminstExecClause :: Maybe ExceptionClause
         -- | optional keep alive clause
      ,  comminstKeepAliveClause :: Maybe KeepAliveClause}
    | Load
733
734
      {  -- | Bool indicating if Loc is a poiner
         loadIsPtr :: Bool
735
736
737
738
739
740
741
742
743
         -- | Optional Memory order (default NOT_ATOMIC)
      ,  loadMemOrd :: Maybe MemoryOrder
         -- | The referant type of loc
      ,  loadType :: TypedefName
         -- | Variable of type IRef or UPtr (the mem location to load from)
      ,  loadLoc :: VarName
         -- | Exception clause if operation fails
      ,  loadExecClause :: Maybe ExceptionClause}
    | Store
744
745
      {  -- | Bool indicating if loc is a pointer
         storeIsPtr :: Bool
746
747
748
749
750
751
752
753
754
755
         -- | Memory order for operation
      ,  storeMemOrd :: Maybe MemoryOrder
         -- | Type of loc
      ,  storeType :: TypedefName
         -- | variable of IRef or UPtr. Mem loc/addr to store into
      ,  storeLoc :: VarName
         -- | The new value to store
      ,  storeNewVal :: VarName
         -- | Optional exception clause
      ,  storeExecClause :: Maybe ExceptionClause}
756
    | ExtractValue { structExtractType :: TypedefName
757
                   ,  structExtractIndex :: Int
758
759
                   ,  structExtractStruct :: VarName}
    | InsertValue { structInsertType :: TypedefName
760
761
                  ,  structInsertIndex :: Int
                  ,  structInsertStruct :: VarName
762
763
                  ,  structInsertNewVal :: VarName}
    | ExtractElement { arrExtractType :: TypedefName
764
765
                  ,  arrExtractIndexType :: TypedefName
                  ,  arrExtractOpnd :: VarName
766
767
                  ,  arrExtractIndex :: VarName}
    | InsertElement { arrInsertType :: TypedefName
768
769
770
                 ,  arrInsertIndexType :: TypedefName
                 ,  arrInsertOpnd :: VarName
                 ,  arrInsertIndex :: VarName
771
                 ,  arrInsertNewVal :: VarName}
772
773
    | ShuffleVector { arrShuffleVType :: TypedefName
                   ,  arrShuffleMaskType :: TypedefName
774
775
                   ,  arrShuffleV1 :: VarName
                   ,  arrShuffleV2 :: VarName
776
                   ,  arrShuffleMask :: VarName}
777
    | GetIRef { getIRefType :: TypedefName
778
             ,  getIRefOpnd :: VarName}
779
780
781
    | GetFieldIRef { getFieldIRefPtr :: Bool
                  ,  getFieldIRefTypeOpnd :: TypedefName
                  ,  getFieldIRefIndex :: Int
782
                  ,  getFieldIRefOpnd :: VarName}
783
784
785
786
    | GetElemIRef { getElemIRefPtr :: Bool
                 ,  getElemIRefTypeOpnd :: TypedefName
                 ,  getElemIRefTypeIndex :: TypedefName
                 ,  getElemIRefOpnd :: VarName
787
                 ,  getElemIRefIndex :: VarName}
788
789
790
791
    | ShiftIRef { shiftIRefPtr :: Bool
               ,  shiftIRefTypeOpnd :: TypedefName
               ,  shiftIRefTypeIndex :: TypedefName
               ,  shiftIRefOpnd :: VarName
792
               ,  shiftIRefOffset :: VarName}
793
794
    | GetVarPartIRef { getVarPartIRefPtr :: Bool
                    ,  getVarPartIRefTypeOpnd :: TypedefName
795
                    ,  getVarPartIRefOpnd :: VarName}
796
797
798
    deriving (Generic)

instance Binary Expression
799
800
801
802

data CurStackClause
    = RetWith { retWithTypes :: [TypedefName]}
    | KillOld
803
804
805
    deriving (Generic)

instance Binary CurStackClause
806
807
808
809
810

data NewStackClause
    = PassValues { newStackTypes :: [TypedefName]
                ,  newStackValues :: [VarName]}
    | ThrowExc { throwExecExceptionClause :: VarName}
811
812
813
    deriving (Generic)

instance Binary NewStackClause
814

815
data Assigned a = (:=)
816
    { assignVarss :: [VarName]
817
818
    , assignExpr :: a
    } deriving (Generic)
819

820
instance Binary a => Binary (Assigned a)
821
822

data BasicBlock = BasicBlock
823
824
825
826
    { basicBlockName :: BasicBlockName
    , basicBlockParams :: [(VarName, TypedefName)]
    , basicBlockExcParam :: Maybe VarName
    , basicBlockInstructions :: [Assigned Expression]
827
828
    , basicBlockTerminst :: Expression
    }
829
830
831
    deriving (Generic)

instance Binary BasicBlock