Add types to node
[barrelfish] / tools / sockeye / 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 newtype NodeId = NodeId String deriving (Eq, Ord)
25
26 {-
27 Addresses are natural numbers
28 -}
29 newtype Addr = Addr Word deriving (Eq, Ord)
30
31 {-
32 A block is a contigous set of addresses
33 -}
34 data BlockSpec = BlockSpec
35     { base  :: Addr
36     , limit :: Addr
37     } deriving (Eq, Ord)
38
39 {-
40 A mapping of a source address block to a destination node
41 at a base address
42 -}
43 data MapSpec = MapSpec { srcBlock :: BlockSpec
44                        , destNode :: NodeId
45                        , destBase :: Addr
46                        }
47
48 {-
49 Node can either be memory, device or other
50 -}
51 data NodeType = Memory
52               | Device
53               | Other
54
55 {-
56 A node is specified as a list of blocks it accepts,
57 a list of mappings and possibly an overlay on another block
58 -}
59 data NodeSpec = NodeSpec { nodeType  :: NodeType
60                          , accept    :: [BlockSpec]
61                          , translate :: [MapSpec]
62                          , overlay   :: Maybe NodeId
63                          }
64
65 {-
66 A decoding net is specified as a list 
67 of Node IDs mapped to Nodes
68 -}
69 newtype NetSpec = NetSpec [(NodeId, NodeSpec)]
70
71 {- Pretty Printing -}
72 instance Show NodeId where
73     show (NodeId id) = id
74
75 instance Show Addr where
76     show (Addr addr) = "0x" ++ showHex addr ""
77
78 instance Show BlockSpec where
79     show blockSpec = show (base blockSpec) ++ "-" ++ show (limit blockSpec)
80
81 instance Show MapSpec where
82     show mapSpec = let srcStr  = show $ srcBlock mapSpec
83                        nodeStr = show $ destNode mapSpec
84                        baseStr = show $ destBase mapSpec
85                    in srcStr ++ " to " ++ nodeStr ++ " at " ++ baseStr
86
87 instance Show NodeType where
88   show Memory = "memory"
89   show Device = "device"
90   show Other  = "other"
91
92 instance Show NodeSpec where
93     show nodeSpec = let typeStr      = show $ nodeType nodeSpec
94                         acceptStr    = "accept [" ++ intercalate ", " (map show (accept nodeSpec)) ++ "]"
95                         translateStr = "map [" ++ intercalate ", " (map show (translate nodeSpec)) ++ "]"
96                         overlayStr   = case overlay nodeSpec of
97                                         Nothing     -> ""
98                                         Just nodeId -> "over " ++ show nodeId
99                     in intercalate " " [typeStr, acceptStr, translateStr, overlayStr]
100
101 instance Show NetSpec where
102     show (NetSpec netSpec) = unlines $ map nodeStr netSpec
103                              where nodeStr (id, node) = show id ++ " is " ++ show node