Sockeye: Code cleanup
[barrelfish] / tools / sockeye / SockeyeBackendProlog.hs
1 {-
2   SockeyeBackendProlog.hs: Backend for generating ECLiPSe-Prolog facts 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 TypeSynonymInstances #-}
17 {-# LANGUAGE FlexibleInstances #-}
18
19 module SockeyeBackendProlog
20 ( compile ) where
21
22 import Data.Char
23 import Data.List
24 import qualified Data.Map as Map
25 import Numeric (showHex)
26
27 import qualified SockeyeASTDecodingNet as AST
28
29 compile :: AST.NetSpec -> String
30 compile = generate
31
32 {- Code Generator -}
33 class PrologGenerator a where
34     generate :: a -> String
35
36 instance PrologGenerator AST.NetSpec where
37     generate net = let
38         mapped = Map.mapWithKey toFact net
39         facts = Map.elems mapped
40         in unlines facts
41         where
42             toFact nodeId nodeSpec = let
43                 atom = generate nodeId
44                 node = generate nodeSpec
45                 in predicate "net" [atom, node] ++ "."
46
47 instance PrologGenerator AST.NodeId where
48     generate ast = let
49         name = AST.name ast
50         namespace = AST.namespace ast
51         in predicate "nodeId" [atom name, list $ map atom namespace]
52
53 instance PrologGenerator AST.NodeSpec where
54     generate ast = let
55         nodeType = generate $ AST.nodeType ast
56         accept = generate $ AST.accept ast
57         translate = generate $ AST.translate ast
58         in predicate "node" [nodeType, accept, translate]
59
60 instance PrologGenerator AST.BlockSpec where
61     generate blockSpec = let
62         base = generate $ AST.base blockSpec
63         limit = generate $ AST.limit blockSpec
64         in predicate "block" [base, limit]
65
66 instance PrologGenerator AST.MapSpec where
67     generate mapSpec = let
68         src  = generate $ AST.srcBlock mapSpec
69         dest = generate $ AST.destNode mapSpec
70         base = generate $ AST.destBase mapSpec
71         in predicate "map" [src, dest, base]
72
73 instance PrologGenerator AST.NodeType where
74     generate AST.Memory = atom "memory"
75     generate AST.Device = atom "device"
76     generate AST.Other  = atom "other"
77
78 instance PrologGenerator AST.Address where
79     generate addr = "16'" ++ showHex addr ""
80
81 instance PrologGenerator a => PrologGenerator [a] where
82     generate ast = let
83         mapped = map generate ast
84         in list mapped
85
86 {- Helper functions -}
87 atom :: String -> String
88 atom "" = ""
89 atom name@(c:cs)
90     | isLower c && allAlphaNum cs = name
91     | otherwise = quotes name
92     where
93         allAlphaNum cs = foldl (\acc c -> isAlphaNum c && acc) True cs
94
95 predicate :: String -> [String] -> String
96 predicate name args = name ++ (parens $ intercalate "," args)
97
98 list :: [String] -> String
99 list elems = brackets $ intercalate "," elems
100
101 enclose :: String -> String -> String -> String
102 enclose start end string = start ++ string ++ end
103
104 parens :: String -> String
105 parens = enclose "(" ")"
106
107 brackets :: String -> String
108 brackets = enclose "[" "]"
109
110 quotes :: String -> String
111 quotes = enclose "'" "'"