Sockeye: Start reimplementing net builder on top of instantiator
[barrelfish] / tools / sockeye / SockeyeBackendProlog.hs
index f71360f..4be1bcb 100644 (file)
   Attn: Systems Group.
 -}
 
+{-# LANGUAGE TypeSynonymInstances #-}
+{-# LANGUAGE FlexibleInstances #-}
+
 module SockeyeBackendProlog
 ( compile ) where
 
-import Data.List
 import Data.Char
+import Data.List
+import qualified Data.Map as Map
 import Numeric (showHex)
 
-import qualified SockeyeASTDecodingNetOld as AST
+import qualified SockeyeASTDecodingNet as AST
 
 compile :: AST.NetSpec -> String
 compile = generate
@@ -30,41 +34,64 @@ class PrologGenerator a where
     generate :: a -> String
 
 instance PrologGenerator AST.NetSpec where
-    generate (AST.NetSpec net) = unlines $ map toFact net
-        where toFact (nodeId, nodeSpec) = let atom = generate nodeId
-                                              node = generate nodeSpec
-                                          in predicate "net" [atom, node] ++ "."
+    generate net = let
+        mapped = Map.mapWithKey toFact net
+        facts = Map.elems mapped
+        in unlines facts
+        where
+            toFact nodeId nodeSpec = let
+                atom = generate nodeId
+                node = generate nodeSpec
+                in predicate "net" [atom, node] ++ "."
 
 instance PrologGenerator AST.NodeId where
-    generate (AST.NodeId id) = quotes id
+    generate ast = let
+        name = AST.name ast
+        namespace = AST.namespace ast
+        in predicate "nodeId" [atom name, list $ map atom namespace]
 
 instance PrologGenerator AST.NodeSpec where
-    generate nodeSpec = predicate "node" [nodeType, accept, translate, overlay]
-        where nodeType = generate (AST.nodeType nodeSpec)
-              accept = list $ map generate (AST.accept nodeSpec)
-              translate = list $ map generate (AST.translate nodeSpec)
-              overlay = case AST.overlay nodeSpec of
-                Nothing -> "'@none'"
-                Just id -> generate id
+    generate ast = let
+        nodeType = generate $ AST.nodeType ast
+        accept = generate $ AST.accept ast
+        translate = generate $ AST.translate ast
+        in predicate "node" [nodeType, accept, translate]
 
 instance PrologGenerator AST.BlockSpec where
-    generate blockSpec = let base  = generate $ AST.base blockSpec
-                             limit = generate $ AST.limit blockSpec
-                         in predicate "block" [base, limit]
+    generate blockSpec = let
+        base = generate $ AST.base blockSpec
+        limit = generate $ AST.limit blockSpec
+        in predicate "block" [base, limit]
 
 instance PrologGenerator AST.MapSpec where
-    generate mapSpec = let src  = generate $ AST.srcBlock mapSpec
-                           dest = generate $ AST.destNode mapSpec
-                           base = generate $ AST.destBase mapSpec
-                       in predicate "map" [src, dest, base]
+    generate mapSpec = let
+        src  = generate $ AST.srcBlock mapSpec
+        dest = generate $ AST.destNode mapSpec
+        base = generate $ AST.destBase mapSpec
+        in predicate "map" [src, dest, base]
 
 instance PrologGenerator AST.NodeType where
-    generate = show 
+    generate AST.Memory = atom "memory"
+    generate AST.Device = atom "device"
+    generate AST.Other  = atom "other"
 
-instance PrologGenerator AST.Addr where
-    generate (AST.Addr addr) = "16'" ++ showHex addr ""
+instance PrologGenerator AST.Address where
+    generate addr = "16'" ++ showHex addr ""
+
+instance PrologGenerator a => PrologGenerator [a] where
+    generate ast = let
+        mapped = map generate ast
+        in list mapped
 
 {- Helper functions -}
+atom :: String -> String
+atom "" = ""
+atom name@(c:cs)
+    | isLower c && allAlphaNum cs = name
+    | otherwise = quotes name
+    where
+        allAlphaNum cs = foldl (\acc c -> isAlphaNum c && acc) True cs
+
 predicate :: String -> [String] -> String
 predicate name args = name ++ (parens $ intercalate "," args)