Rename sockey2 -> sockeye
[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 A node is specified as a list of blocks it accepts,
50 a list of mappings and possibly an overlay on another block
51 -}
52 data NodeSpec = NodeSpec { accept    :: [BlockSpec]
53                          , translate :: [MapSpec]
54                          , overlay   :: Maybe NodeId
55                          }
56
57 {-
58 A decoding net is specified as a list 
59 of Node IDs mapped to Nodes
60 -}
61 newtype NetSpec = NetSpec [(NodeId, NodeSpec)]
62
63 {- Pretty Printing -}
64 instance Show NodeId where
65     show (NodeId id) = id
66
67 instance Show Addr where
68     show (Addr addr) = "0x" ++ showHex addr ""
69
70 instance Show BlockSpec where
71     show blockSpec = show (base blockSpec) ++ "-" ++ show (limit blockSpec)
72
73 instance Show MapSpec where
74     show mapSpec = let srcStr  = show $ srcBlock mapSpec
75                        nodeStr = show $ destNode mapSpec
76                        baseStr = show $ destBase mapSpec
77                    in srcStr ++ " to " ++ nodeStr ++ " at " ++ baseStr
78
79 instance Show NodeSpec where
80     show nodeSpec = let acceptStr    = "accept [" ++ intercalate ", " (map show (accept nodeSpec)) ++ "]"
81                         translateStr = "map [" ++ intercalate ", " (map show (translate nodeSpec)) ++ "]"
82                         overlayStr   = case overlay nodeSpec of
83                                         Nothing     -> ""
84                                         Just nodeId -> "over " ++ show nodeId
85                     in acceptStr ++ " " ++ translateStr ++ " " ++ overlayStr
86
87 instance Show NetSpec where
88     show (NetSpec netSpec) = unlines $ map nodeStr netSpec
89                              where nodeStr (id, node) = show id ++ " is " ++ show node