22fee6edf8ecdefabbcced13c093e583908ce946
[barrelfish] / tools / sockeye2 / SockeyeAST.hs
1 {-
2   SockeyeAST.hs: AST for Sockeye
3
4   Part of Sockeye
5
6   Copyright (c) 2017, ETH Zurich.
7
8   All rights reserved.
9
10   This file is distributed under the terms in the attached LICENSE file.
11   If you do not find this file, copies can be found by writing to:
12   ETH Zurich D-INFK, CAB F.78, Universitaetstr. 6, CH-8092 Zurich,
13   Attn: Systems Group.
14 -}
15
16 module SockeyeAST where
17
18 import Data.List
19 import Numeric (showHex)
20
21 {-
22 Nodes are identfied by strings
23 -}
24 type NodeId = String
25
26 {-
27 Addresses are natural numbers
28 -}
29 type Addr = Word
30
31 {-
32 A block is a contigous set of addresses
33 -}
34 data BlockSpec = BlockSpec { base  :: Addr
35                            , limit :: Addr
36                            } deriving (Ord, Eq)
37
38 {-
39 A mapping of a source address block to a destination node
40 at a base address
41 -}
42 data MapSpec = MapSpec { srcBlock :: BlockSpec
43                        , destNode :: NodeId
44                        , destBase :: Addr
45                        }
46
47 {-
48 A node is specified as a list of blocks it accepts,
49 a list of mappings and possibly an overlay on another block
50 -}
51 data NodeSpec = NodeSpec { accept    :: [BlockSpec]
52                          , translate :: [MapSpec]
53                          , overlay   :: Maybe NodeId
54                          }
55
56 {-
57 A decoding net is specified as a list 
58 of Node IDs mapped to Nodes
59 -}
60 newtype NetSpec = NetSpec { getNodes :: [(NodeId, NodeSpec)] }
61
62 {- Pretty Printing -}
63 instance Show BlockSpec where
64     show blockSpec = "0x" ++ showHex (base blockSpec) "" ++ "-" ++ "0x" ++ showHex (limit blockSpec) ""
65
66 instance Show MapSpec where
67     show mapSpec = let srcStr  = show $ srcBlock mapSpec
68                        nodeStr = destNode mapSpec
69                        baseStr = "0x" ++ showHex (destBase mapSpec) ""
70                    in srcStr ++ " to " ++ nodeStr ++ " at " ++ baseStr
71
72 instance Show NodeSpec where
73     show nodeSpec = let acceptStr    = "accept [" ++ intercalate ", " (map show (accept nodeSpec)) ++ "]"
74                         translateStr = "map [" ++ intercalate ", " (map show (translate nodeSpec)) ++ "]"
75                         overlayStr   = case overlay nodeSpec of Nothing     -> ""
76                                                                 Just nodeId -> "over " ++ nodeId
77                     in acceptStr ++ " " ++ translateStr ++ " " ++ overlayStr
78
79 instance Show NetSpec where
80     show netSpec = intercalate "\n" (map nodeStr (getNodes netSpec))
81         where nodeStr (id, node) = id ++ " is " ++ show node