Sockeye: Finish AST simplification
[barrelfish] / tools / sockeye / SockeyeNetBuilder.hs
1 {-
2     SockeyeNetBuilder.hs: Decoding net builder 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 {-# LANGUAGE MultiParamTypeClasses #-}
17 {-# LANGUAGE FlexibleInstances #-}
18 {-# LANGUAGE FlexibleContexts #-}
19
20 module SockeyeNetBuilder
21 ( sockeyeBuildNet ) where
22
23 import Control.Monad.State
24
25 import Data.Either
26 import Data.List (nub, intercalate)
27 import Data.Map (Map)
28 import qualified Data.Map as Map
29 import Data.Maybe (fromMaybe, maybe)
30 import Data.Set (Set)
31 import qualified Data.Set as Set
32
33 import Numeric (showHex)
34
35 import qualified SockeyeAST as AST
36 import qualified SockeyeASTDecodingNet as NetAST
37
38 import Text.Groom (groom)
39 import Debug.Trace
40
41 type NetNodeDecl = (NetAST.NodeId, NetAST.NodeSpec)
42 type NetList = [NetNodeDecl]
43 type PortList = [NetAST.NodeId]
44 type PortMap = [(NetAST.NodeId, NetAST.NodeId)]
45
46 data FailedCheck
47     = DuplicateInPort AST.ModuleInst NetAST.NodeId
48     | UndefinedInPort AST.ModuleInst NetAST.NodeId
49     | DuplicateOutPort AST.ModuleInst NetAST.NodeId
50     | UndefinedOutPort AST.ModuleInst NetAST.NodeId
51     | DuplicateIdentifer NetAST.NodeId
52     | UndefinedReference NetAST.NodeId
53
54 instance Show FailedCheck where
55     show (DuplicateInPort modInst ident) = concat ["Multiple declarations of input port '", NetAST.name ident, "' in '", show modInst, "'"]
56     show (UndefinedInPort modInst ident) = concat ["'", NetAST.name ident, "' is not an input port in '", show modInst, "'"]
57     show (DuplicateOutPort modInst ident) = concat ["Multiple declarations of output port '", NetAST.name ident, "' in '", show modInst, "'"]
58     show (UndefinedOutPort modInst ident) = concat ["'", NetAST.name ident, "' is not an output port in '", show modInst, "'"]
59     show (DuplicateIdentifer ident)   = concat ["Multiple declarations of node '", show ident, "'"]
60     show (UndefinedReference ident)   = concat ["Reference to undefined node '", show ident, "'"]
61
62 newtype CheckFailure = CheckFailure
63     { failures :: [FailedCheck] }
64
65 instance Show CheckFailure where
66     show (CheckFailure fs) = unlines $ map show fs
67
68 data Context = Context
69     { spec         :: AST.SockeyeSpec
70     , curNamespace :: NetAST.Namespace
71     , paramValues  :: Map String Word
72     , varValues    :: Map String Word
73     }
74
75 sockeyeBuildNet :: AST.SockeyeSpec -> Either CheckFailure NetAST.NetSpec
76 sockeyeBuildNet ast = do
77     let
78         context = Context
79             { spec         = ast
80             , curNamespace = NetAST.Namespace []
81             , paramValues  = Map.empty
82             , varValues    = Map.empty
83             }
84         emptySpec = AST.SockeyeSpec Map.empty
85         rootInst = AST.ModuleInst
86             { AST.namespace  = AST.SimpleIdent ""
87             , AST.moduleName = "@root"
88             , AST.arguments  = Map.empty
89             , AST.inPortMap  = []
90             , AST.outPortMap = []
91             }
92         (netRoots, simpleAST) = runState (simplify context rootInst) emptySpec
93     trace (groom (netRoots :: [AST.ModuleInst])) $ return ()
94     trace (groom simpleAST) $ return ()
95     return NetAST.NetSpec
96         { NetAST.net = Map.empty }
97     -- let
98     --     nodeIds = map fst net
99     -- checkDuplicates nodeIds DuplicateIdentifer
100     -- let
101     --     nodeMap = Map.fromList net
102     --     symbols = Map.keysSet nodeMap
103     --     netSpec = NetAST.NetSpec $ nodeMap
104     -- check symbols netSpec
105     -- return netSpec
106
107 --
108 -- Simplify AST (instantiate module templates, expand for constructs)
109 --
110 class ASTSimplifiable a b where
111     simplify :: Context -> a -> State AST.SockeyeSpec b
112
113 instance ASTSimplifiable AST.Module AST.Module where
114     simplify context ast = do
115         let
116             inPorts = AST.inputPorts ast
117             outPorts = AST.outputPorts ast
118             nodeDecls = AST.nodeDecls ast
119             moduleInsts = AST.moduleInsts ast
120         simpleInPorts <- simplify context inPorts
121         simpleOutPorts <- simplify context outPorts
122         simpleDecls <- simplify context nodeDecls
123         simpleInsts <- simplify context moduleInsts
124         return AST.Module
125             { AST.paramNames   = []
126             , AST.paramTypeMap = Map.empty
127             , AST.inputPorts   = concat (simpleInPorts :: [[AST.Port]])
128             , AST.outputPorts  = concat (simpleOutPorts :: [[AST.Port]])
129             , AST.nodeDecls    = concat (simpleDecls :: [[AST.NodeDecl]])
130             , AST.moduleInsts  = concat (simpleInsts :: [[AST.ModuleInst]])
131             }
132
133 instance ASTSimplifiable AST.Port [AST.Port] where
134     simplify context (AST.MultiPort for) = do
135         simpleFor <- simplify context for
136         return $ concat (simpleFor :: [[AST.Port]])
137     simplify context (AST.Port ident) = do
138         simpleIdent <- simplify context ident
139         return [AST.Port simpleIdent]
140
141 instance ASTSimplifiable AST.ModuleInst [AST.ModuleInst] where
142     simplify context (AST.MultiModuleInst for) = do 
143         simpleFor <- simplify context for
144         return $ concat (simpleFor :: [[AST.ModuleInst]])
145     simplify context ast = do
146         let
147             namespace = AST.namespace ast
148             name = AST.moduleName ast
149             args = AST.arguments ast
150             inPortMap = AST.inPortMap ast
151             outPortMap = AST.outPortMap ast
152             mod = getModule context name
153         simpleNS <- simplify context namespace
154         simpleInMap <- simplify context inPortMap
155         simpleOutMap <- simplify context outPortMap
156         simpleArgs <- simplify context args
157         simpleModule <- simplify (moduleContext simpleArgs) mod
158         let
159             simpleName = concat [name, "(", intercalate ", " $ argValues simpleArgs mod, ")"]
160             simplified = AST.ModuleInst
161                 { AST.namespace  = simpleNS
162                 , AST.moduleName = simpleName
163                 , AST.arguments  = Map.empty
164                 , AST.inPortMap  = concat (simpleInMap :: [[AST.PortMap]])
165                 , AST.outPortMap = concat (simpleOutMap :: [[AST.PortMap]])
166                 }
167         modify $ addModule simpleName simpleModule
168         return [simplified]
169         where
170             moduleContext paramValues = context
171                     { paramValues = paramValues
172                     , varValues   = Map.empty
173                     }
174             argValues args mod =
175                 let
176                     paramNames = AST.paramNames mod
177                     paramTypes = AST.paramTypeMap mod
178                     params = map (\p -> (p, paramTypes Map.! p)) paramNames
179                 in map showValue params
180                     where
181                         showValue (name, AST.AddressParam)  = "0x" ++ showHex (args Map.! name) ""
182                         showValue (name, AST.NaturalParam) = show (args Map.! name)
183             addModule k m spec =
184                 let
185                     prevMods = AST.modules spec
186                     newMods = Map.insert k m prevMods
187                 in spec
188                     { AST.modules = newMods }
189
190 instance ASTSimplifiable AST.ModuleArg Word where
191     simplify _ (AST.AddressArg v) = return v
192     simplify _ (AST.NaturalArg v) = return v
193     simplify context (AST.ParamArg name) = return $ getParamValue context name
194
195 instance ASTSimplifiable AST.PortMap [AST.PortMap] where
196     simplify context (AST.MultiPortMap for) = do
197         simpleFor <- simplify context for
198         return $ concat (simpleFor :: [[AST.PortMap]])
199     simplify context ast = do
200         let
201             mappedId = AST.mappedId ast
202             mappedPort = AST.mappedPort ast
203         simpleId <- simplify context mappedId
204         simplePort <- simplify context mappedPort
205         let
206             simplePortMap = AST.PortMap
207                 { AST.mappedId   = simpleId
208                 , AST.mappedPort = simplePort
209                 }
210         return [simplePortMap]
211
212 instance ASTSimplifiable AST.NodeDecl [AST.NodeDecl] where
213     simplify context (AST.MultiNodeDecl for) = do
214         simpleFor <- simplify context for
215         return $ concat (simpleFor :: [[AST.NodeDecl]])
216     simplify context ast = do
217         let
218             nodeId = AST.nodeId ast
219             nodeSpec = AST.nodeSpec ast
220         simpleNodeId <- simplify context nodeId
221         simpleNodeSpec <- simplify context nodeSpec
222         let
223             simpleNodeDecl = AST.NodeDecl
224                 { AST.nodeId   = simpleNodeId
225                 , AST.nodeSpec = simpleNodeSpec
226                 }
227         return [simpleNodeDecl]
228
229 instance ASTSimplifiable AST.Identifier AST.Identifier where
230     simplify context ast = do
231         let
232             name = simpleName ast
233         return $ AST.SimpleIdent name
234         where
235             simpleName (AST.SimpleIdent name) = name
236             simpleName ident =
237                 let
238                     prefix = AST.prefix ident
239                     varName = AST.varName ident
240                     suffix = AST.suffix ident
241                     varValue = show $ getVarValue context varName
242                     suffixName = case suffix of
243                         Nothing -> ""
244                         Just s  -> simpleName s
245                 in prefix ++ varValue ++ suffixName
246
247 instance ASTSimplifiable AST.NodeSpec AST.NodeSpec where
248     simplify context ast = do
249         let
250             nodeType = AST.nodeType ast
251             accept = AST.accept ast
252             translate = AST.translate ast
253             overlay = AST.overlay ast
254         simpleAccept <- simplify context accept
255         simpleTranslate <- simplify context translate
256         simpleOverlay <- maybe (return Nothing) simplifyOverlay overlay
257         return AST.NodeSpec
258             { AST.nodeType  = nodeType
259             , AST.accept    = simpleAccept
260             , AST.translate = simpleTranslate
261             , AST.overlay   = simpleOverlay
262             }
263         where
264             simplifyOverlay ident = do
265                 simpleIdent <- simplify context ident
266                 return $ Just simpleIdent
267
268 instance ASTSimplifiable AST.BlockSpec AST.BlockSpec where
269     simplify context (AST.SingletonBlock base) = do
270         simpleBase <- simplify context base
271         return $ AST.SingletonBlock simpleBase
272     simplify context (AST.RangeBlock base limit) = do
273         simpleBase <- simplify context base
274         simpleLimit <- simplify context limit
275         return AST.RangeBlock
276             { AST.base  = simpleBase
277             , AST.limit = simpleLimit
278             }
279     simplify context (AST.LengthBlock base bits) = do
280         simpleBase <- simplify context base
281         return AST.LengthBlock
282             { AST.base = simpleBase
283             , AST.bits = bits
284             }
285
286 instance ASTSimplifiable AST.MapSpec AST.MapSpec where
287     simplify context ast = do
288         let
289             block = AST.block ast
290             destNode = AST.destNode ast
291             destBase = fromMaybe (AST.base block) (AST.destBase ast)
292         simpleBlock <- simplify context block
293         simpleDestNode <- simplify context destNode
294         simpleDestBase <- simplify context destBase
295         return AST.MapSpec
296             { AST.block    = simpleBlock
297             , AST.destNode = simpleDestNode
298             , AST.destBase = Just simpleDestBase
299             }
300
301 instance ASTSimplifiable AST.Address AST.Address where
302     simplify context (AST.ParamAddress name) = do
303         let value = getParamValue context name
304         return $ AST.LiteralAddress value
305     simplify _ ast = return ast
306
307 instance ASTSimplifiable a b => ASTSimplifiable (AST.For a) [b] where
308     simplify context ast = do
309         let
310             body = AST.body ast
311             varRanges = AST.varRanges ast
312         concreteRanges <- simplify context varRanges
313         let
314             valueList = Map.foldWithKey iterations [] concreteRanges
315             iterContexts = map iterationContext valueList
316         mapM (\c -> simplify c body) iterContexts
317             where
318                 iterations k vs [] = [Map.fromList [(k,v)] | v <- vs]
319                 iterations k vs ms = concat $ map (f ms k) vs
320                     where
321                         f ms k v = map (Map.insert k v) ms
322                 iterationContext varMap =
323                     let
324                         values = varValues context
325                     in context
326                         { varValues = values `Map.union` varMap }
327
328 instance ASTSimplifiable AST.ForRange [Word] where
329     simplify context ast = do
330         let
331             start = AST.start ast
332             end = AST.end ast
333         simpleStart <- simplify context start
334         simpleEnd <- simplify context end
335         return [simpleStart..simpleEnd]
336
337 instance ASTSimplifiable AST.ForLimit Word where
338     simplify _ (AST.LiteralLimit value) = return value
339     simplify context (AST.ParamLimit name) = return $ getParamValue context name
340
341 instance (Traversable t, ASTSimplifiable a b) => ASTSimplifiable (t a) (t b) where
342     simplify context ast = mapM (simplify context) ast
343
344 --            
345 -- Build net
346 --
347 -- class NetTransformable a b where
348 --     transform :: Context -> a -> Either CheckFailure b
349
350 -- instance NetTransformable AST.SockeyeSpec NetList where
351 --     transform context ast = do
352 --         let
353 --             rootInst = AST.ModuleInst
354 --                 { AST.namespace  = AST.SimpleIdent ""
355 --                 , AST.moduleName = "@root"
356 --                 , AST.arguments  = Map.empty
357 --                 , AST.inPortMap  = []
358 --                 , AST.outPortMap = []
359 --                 }
360 --             specContext = context
361 --                 { spec = ast }
362 --         transform specContext rootInst
363
364 -- instance NetTransformable AST.Port PortList where
365 --     transform context (AST.MultiPort for) = do
366 --         ts <- transform context for
367 --         return $ concat (ts :: [PortList])
368 --     transform context (AST.Port ident) = do
369 --         netPort <- transform context ident
370 --         return [netPort]
371
372 -- instance NetTransformable AST.ModuleInst NetList where
373 --     transform context (AST.MultiModuleInst for) = do
374 --         ts <- transform context for
375 --         return $ concat (ts :: [NetList])
376 --     transform context ast = do
377 --         let
378 --             namespace = AST.namespace ast
379 --             name = AST.moduleName ast
380 --             args = AST.arguments ast
381 --             inPortMap = AST.inPortMap ast
382 --             outPortMap = AST.outPortMap ast
383 --             mod = getModule context name
384 --             inPorts = AST.inputPorts mod
385 --             outPorts = AST.outputPorts mod
386 --             nodeDecls = AST.nodeDecls mod
387 --             modInsts = AST.moduleInsts mod
388 --         argValues <- transform context args
389 --         let
390 --             netNamespace = identToName context namespace
391 --             modContext = moduleContext netNamespace argValues
392 --         netInPorts <- do
393 --             ts <- transform modContext inPorts
394 --             return $ concat (ts :: [PortList])
395 --         netOutPorts <- do
396 --             ts <- transform modContext outPorts
397 --             return $ concat (ts :: [PortList])
398 --         checkDuplicates netInPorts (DuplicateInPort ast)
399 --         checkDuplicates netOutPorts (DuplicateOutPort ast)
400 --         declNet <- transform modContext nodeDecls
401 --         instNet <- transform modContext modInsts
402 --         return . concat $ declNet ++ instNet
403 --         where
404 --             moduleContext namespace paramValues =
405 --                 let
406 --                     curNS = NetAST.ns $ curNamespace context
407 --                     newNS = case namespace of
408 --                         "" -> NetAST.Namespace curNS
409 --                         _  -> NetAST.Namespace $ namespace:curNS
410 --                 in context
411 --                     { curNamespace = newNS
412 --                     , paramValues  = paramValues
413 --                     , varValues    = Map.empty
414 --                     }
415
416 -- instance NetTransformable AST.PortMap PortMap where
417 --     transform context (AST.MultiPortMap for) = do
418 --         ts <- transform context for
419 --         return $ concat (ts :: [PortMap])
420 --     transform context ast = do
421 --         let
422 --             mappedId = AST.mappedId ast
423 --             mappedPort = AST.mappedPort ast
424 --         netMappedId <- transform context mappedId
425 --         netMappedPort <- transform context mappedPort
426 --         return [(netMappedId, netMappedPort)]
427
428 -- instance NetTransformable AST.ModuleArg Word where
429 --     transform context (AST.AddressArg value) = return value
430 --     transform context (AST.NaturalArg value) = return value
431 --     transform context (AST.ParamArg name) = return $ getParamValue context name
432
433 -- instance NetTransformable AST.Identifier NetAST.NodeId where
434 --     transform context ast = do
435 --         let
436 --             namespace = curNamespace context
437 --             name = identToName context ast
438 --         return NetAST.NodeId
439 --             { NetAST.namespace = namespace
440 --             , NetAST.name      = name
441 --             }
442
443 -- instance NetTransformable AST.NodeDecl NetList where
444 --     transform context (AST.MultiNodeDecl for) = do
445 --         ts <- transform context for
446 --         return $ concat (ts :: [NetList])
447 --     transform context ast = do
448 --         let
449 --             ident = AST.nodeId ast
450 --             nodeSpec = AST.nodeSpec ast
451 --         nodeId <- transform context ident
452 --         netNodeSpec <- transform context nodeSpec
453 --         return [(nodeId, netNodeSpec)]
454
455 -- instance NetTransformable AST.NodeSpec NetAST.NodeSpec where
456 --     transform context ast = do
457 --         let
458 --             nodeType = AST.nodeType ast
459 --             accept = AST.accept ast
460 --             translate = AST.translate ast
461 --             overlay = AST.overlay ast
462 --         netNodeType <- maybe (return NetAST.Other) (transform context) nodeType
463 --         netAccept <- transform context accept
464 --         netTranslate <- transform context translate
465 --         netOverlay <- case overlay of
466 --                 Nothing -> return Nothing
467 --                 Just o  -> do 
468 --                     t <- transform context o
469 --                     return $ Just t
470 --         return NetAST.NodeSpec
471 --             { NetAST.nodeType  = netNodeType
472 --             , NetAST.accept    = netAccept
473 --             , NetAST.translate = netTranslate
474 --             , NetAST.overlay   = netOverlay
475 --             }
476
477 -- instance NetTransformable AST.NodeType NetAST.NodeType where
478 --     transform _ AST.Memory = return NetAST.Memory
479 --     transform _ AST.Device = return NetAST.Device
480
481 -- instance NetTransformable AST.BlockSpec NetAST.BlockSpec where
482 --     transform context (AST.SingletonBlock address) = do
483 --         netAddress <- transform context address
484 --         return NetAST.BlockSpec
485 --             { NetAST.base  = netAddress
486 --             , NetAST.limit = netAddress
487 --             }
488 --     transform context (AST.RangeBlock base limit) = do
489 --         netBase <- transform context base
490 --         netLimit <- transform context limit
491 --         return NetAST.BlockSpec
492 --             { NetAST.base  = netBase
493 --             , NetAST.limit = netLimit
494 --             }
495 --     transform context (AST.LengthBlock base bits) = do
496 --         netBase <- transform context base
497 --         let
498 --             baseAddress = NetAST.address netBase
499 --             limit = baseAddress + 2^bits - 1
500 --             netLimit = NetAST.Address limit
501 --         return NetAST.BlockSpec
502 --             { NetAST.base  = netBase
503 --             , NetAST.limit = netLimit
504 --             }
505
506 -- instance NetTransformable AST.MapSpec NetAST.MapSpec where
507 --     transform context ast = do
508 --         let
509 --             block = AST.block ast
510 --             destNode = AST.destNode ast
511 --             destBase = fromMaybe (AST.base block) (AST.destBase ast)
512 --         netBlock <- transform context block
513 --         netDestNode <- transform context destNode
514 --         netDestBase <- transform context destBase
515 --         return NetAST.MapSpec
516 --             { NetAST.srcBlock = netBlock
517 --             , NetAST.destNode = netDestNode
518 --             , NetAST.destBase = netDestBase
519 --             }
520
521 -- instance NetTransformable AST.Address NetAST.Address where
522 --     transform _ (AST.LiteralAddress value) = do
523 --         return $ NetAST.Address value
524 --     transform context (AST.ParamAddress name) = do
525 --         let
526 --             value = getParamValue context name
527 --         return $ NetAST.Address value
528
529 -- instance NetTransformable a b => NetTransformable (AST.For a) [b] where
530 --     transform context ast = do
531 --         let
532 --             body = AST.body ast
533 --             varRanges = AST.varRanges ast
534 --         concreteRanges <- transform context varRanges
535 --         let
536 --             valueList = Map.foldWithKey iterations [] concreteRanges
537 --             iterContexts = map iterationContext valueList
538 --             ts = map (\c -> transform c body) iterContexts
539 --             fs = lefts ts
540 --             bs = rights ts
541 --         case fs of
542 --             [] -> return $ bs
543 --             _  -> Left $ CheckFailure (concat $ map failures fs)
544 --         where
545 --             iterations k vs [] = [Map.fromList [(k,v)] | v <- vs]
546 --             iterations k vs ms = concat $ map (f ms k) vs
547 --                 where
548 --                     f ms k v = map (Map.insert k v) ms
549 --             iterationContext varMap =
550 --                 let
551 --                     values = varValues context
552 --                 in context
553 --                     { varValues = values `Map.union` varMap }
554
555 -- instance NetTransformable AST.ForRange [Word] where
556 --     transform context ast = do
557 --         let
558 --             start = AST.start ast
559 --             end = AST.end ast
560 --         startVal <- transform context start
561 --         endVal <- transform context end
562 --         return [startVal..endVal]
563
564 -- instance NetTransformable AST.ForLimit Word where
565 --     transform _ (AST.LiteralLimit value) = return value
566 --     transform context (AST.ParamLimit name) = return $ getParamValue context name
567
568 -- instance NetTransformable a b => NetTransformable [a] [b] where
569 --     transform context ast = do
570 --         let
571 --             ts = map (transform context) ast
572 --             fs = lefts ts
573 --             bs = rights ts
574 --         case fs of
575 --             [] -> return bs
576 --             _  -> Left $ CheckFailure (concat $ map failures fs)
577
578 -- instance (Ord k, NetTransformable a b) => NetTransformable (Map k a) (Map k b) where
579 --     transform context ast = do
580 --         let
581 --             ks = Map.keys ast
582 --             es = Map.elems ast
583 --         ts <- transform context es
584 --         return $ Map.fromList (zip ks ts)
585
586 --
587 -- Checks
588 --
589 class NetCheckable a where
590     check :: Set NetAST.NodeId -> a -> Either CheckFailure ()
591
592 instance NetCheckable NetAST.NetSpec where
593     check context (NetAST.NetSpec net) = do
594         check context $ Map.elems net
595
596 instance NetCheckable NetAST.NodeSpec where
597     check context (NetAST.AliasSpec alias) = do
598         case alias of
599             Nothing -> return ()
600             Just ident -> check context ident
601     check context net = do
602         let
603             translate = NetAST.translate net
604             overlay = NetAST.overlay net
605         check context translate
606         maybe (return ()) (check context) overlay
607
608 instance NetCheckable NetAST.MapSpec where
609     check context net = do
610         let
611            destNode = NetAST.destNode net
612         check context destNode
613
614 instance NetCheckable NetAST.NodeId where
615     check context net = do
616         if net `Set.member` context
617             then return ()
618             else Left $ CheckFailure [UndefinedReference net]
619
620 instance NetCheckable a => NetCheckable [a] where
621     check context net = do
622         let
623             checked = map (check context) net
624             fs = lefts $ checked
625         case fs of
626             [] -> return ()
627             _  -> Left $ CheckFailure (concat $ map failures fs)
628
629 getModule :: Context -> String -> AST.Module
630 getModule context name =
631     let
632         modules = AST.modules $ spec context
633     in modules Map.! name
634
635 getParamValue :: Context -> String -> Word
636 getParamValue context name =
637     let
638         params = paramValues context
639     in params Map.! name
640
641 getVarValue :: Context -> String -> Word
642 getVarValue context name =
643     let
644         vars = varValues context
645     in vars Map.! name
646
647 checkDuplicates :: [NetAST.NodeId] -> (NetAST.NodeId -> FailedCheck) -> Either CheckFailure ()
648 checkDuplicates nodeIds fail = do
649     let
650         duplicates = duplicateNames nodeIds
651     case duplicates of
652         [] -> return ()
653         _  -> Left $ CheckFailure (map fail duplicates)
654     where
655         duplicateNames [] = []
656         duplicateNames (x:xs)
657             | x `elem` xs = nub $ [x] ++ duplicateNames xs
658             | otherwise = duplicateNames xs
659         msg (NetAST.NodeId namespace name) =
660             let
661                 m = concat ["Multiple declarations of node '", name, "'"]
662             in case NetAST.ns namespace of
663                 [] -> m
664                 _  -> m ++ concat [" in namespace '", show namespace, "'"]