Sockeye: Adapt prolog backend to new AST
authorDaniel Schwyn <schwyda@student.ethz.ch>
Wed, 12 Jul 2017 14:56:54 +0000 (16:56 +0200)
committerDaniel Schwyn <schwyda@student.ethz.ch>
Wed, 12 Jul 2017 14:57:42 +0000 (16:57 +0200)
Signed-off-by: Daniel Schwyn <schwyda@student.ethz.ch>

tools/sockeye/Main.hs
tools/sockeye/SockeyeASTDecodingNet.hs
tools/sockeye/SockeyeASTDecodingNetOld.hs [deleted file]
tools/sockeye/SockeyeBackendProlog.hs
tools/sockeye/SockeyeNetBuilder.hs

index 26f5041..7cd1c75 100644 (file)
@@ -151,9 +151,9 @@ buildNet ast = do
         Right netAst -> return netAst
 
 {- Compiles the AST with the appropriate backend -}
--- compile :: Target -> NetAST.NetSpec -> IO String
--- compile None     _   = return ""
--- compile Prolog   ast = return $ Prolog.compile ast
+compile :: Target -> NetAST.NetSpec -> IO String
+compile None     _   = return ""
+compile Prolog   ast = return $ Prolog.compile ast
 
 {- Outputs the compilation result -}
 output :: Maybe FilePath -> String -> IO ()
@@ -170,7 +170,7 @@ main = do
     ast <- checkAST parsedAst
     -- putStrLn $ groom ast ++ "\n"
     netAst <- buildNet ast
-    putStrLn $ groom netAst
-    -- out <- compile (optTarget opts) netAst
-    -- output (optOutputFile opts) out
+    -- putStrLn $ groom netAst ++ "\n"
+    out <- compile (optTarget opts) netAst
+    output (optOutputFile opts) out
     
\ No newline at end of file
index 6ba78c7..1a8a497 100644 (file)
 
 module SockeyeASTDecodingNet where
 
-import Data.List (intersperse)
+import Data.List (intercalate)
 import Data.Map (Map)
 
-type NetSpec = Map NodeId NodeSpec
+newtype NetSpec =
+    NetSpec
+        { net :: Map NodeId NodeSpec }
+    deriving (Show)
 
 data NodeId = NodeId
     { namespace :: Namespace
@@ -36,14 +39,17 @@ newtype Namespace = Namespace
     deriving (Eq, Ord)
 
 instance Show Namespace where
-    show (Namespace ns) = concat $ intersperse "." ns
-
-data NodeSpec = NodeSpec
-    { nodeType  :: NodeType
-    , accept    :: [BlockSpec]
-    , translate :: [MapSpec]
-    , overlay   :: Maybe NodeId
-    } deriving (Show)
+    show (Namespace ns) = intercalate "." ns
+
+data NodeSpec
+    = NodeSpec
+        { nodeType  :: NodeType
+        , accept    :: [BlockSpec]
+        , translate :: [MapSpec]
+        , overlay   :: Maybe NodeId
+        }
+    | AliasSpec (Maybe NodeId)
+    deriving (Show)
 
 data NodeType
     = Memory
@@ -62,4 +68,7 @@ data MapSpec = MapSpec
     , destBase :: Address
     } deriving (Show)
 
-type Address = Word
+newtype Address =
+    Address
+        { address :: Word }
+    deriving (Show)
diff --git a/tools/sockeye/SockeyeASTDecodingNetOld.hs b/tools/sockeye/SockeyeASTDecodingNetOld.hs
deleted file mode 100644 (file)
index 7e21e6f..0000000
+++ /dev/null
@@ -1,77 +0,0 @@
-{-
-  SockeyeASTDecodingNet.hs: Decoding net AST for Sockeye
-
-  Part of Sockeye
-
-  Copyright (c) 2017, ETH Zurich.
-
-  All rights reserved.
-
-  This file is distributed under the terms in the attached LICENSE file.
-  If you do not find this file, copies can be found by writing to:
-  ETH Zurich D-INFK, CAB F.78, Universitaetstr. 6, CH-8092 Zurich,
-  Attn: Systems Group.
--}
-
-module SockeyeASTDecodingNetOld where
-
-{-
-Nodes are identfied by strings
--}
-newtype NodeId = NodeId String
-  deriving (Eq, Ord, Show)
-
-{-
-Addresses are natural numbers
--}
-newtype Addr = Addr Word
-  deriving (Eq, Ord, Show)
-
-{-
-A block is a contigous set of addresses
--}
-data BlockSpec = BlockSpec
-    { base  :: Addr
-    , limit :: Addr
-    } deriving (Eq, Ord, Show)
-
-{-
-A mapping of a source address block to a destination node
-at a base address
--}
-data MapSpec = MapSpec
-    { srcBlock :: BlockSpec
-    , destNode :: NodeId
-    , destBase :: Addr
-    } deriving (Show)
-
-{-
-Node can either be memory, device or other
--}
-data NodeType
-    = Memory
-    | Device
-    | Other
-
-instance Show NodeType where
-    show Memory = "memory"
-    show Device = "device"
-    show Other  = "other"
-
-{-
-A node is specified as a list of blocks it accepts,
-a list of mappings and possibly an overlay on another block
--}
-data NodeSpec = NodeSpec
-    { nodeType  :: NodeType
-    , accept    :: [BlockSpec]
-    , translate :: [MapSpec]
-    , overlay   :: Maybe NodeId
-    } deriving (Show)
-
-{-
-A decoding net is specified as a list 
-of Node IDs mapped to Nodes
--}
-newtype NetSpec = NetSpec [(NodeId, NodeSpec)]
-    deriving (Show)
index f71360f..b6c4ebb 100644 (file)
 module SockeyeBackendProlog
 ( compile ) where
 
-import Data.List
 import Data.Char
+import Data.List
+import qualified Data.Map as Map
+import Data.Maybe
 import Numeric (showHex)
 
-import qualified SockeyeASTDecodingNetOld as AST
+import qualified SockeyeASTDecodingNet as AST
 
 compile :: AST.NetSpec -> String
-compile = generate
+compile = fromJust . generate
 
 {- Code Generator -}
 class PrologGenerator a where
-    generate :: a -> String
+    generate :: a -> Maybe 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 (AST.NetSpec net) = do
+        let
+            mapped = Map.mapWithKey toFact net
+            facts = catMaybes $ Map.elems mapped
+        return $ unlines facts
+        where
+            toFact nodeId nodeSpec = do
+                atom <- generate nodeId
+                node <- generate nodeSpec
+                return $ predicate "net" [atom, node] ++ "."
 
 instance PrologGenerator AST.NodeId where
-    generate (AST.NodeId id) = quotes id
+    generate ast = do
+        return $ (atom $ show ast)
 
 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.AliasSpec alias) = maybe Nothing generate alias
+    generate ast = do
+        nodeType <- generate $ AST.nodeType ast
+        accept <- generate $ AST.accept ast
+        translate <- generate $ AST.translate ast
+        overlay <- case AST.overlay ast of
+            Nothing -> return $ atom "@none"
+            Just id -> generate id
+        return $ predicate "node" [nodeType, accept, translate, overlay]
 
 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 = do
+        base  <- generate $ AST.base blockSpec
+        limit <- generate $ AST.limit blockSpec
+        return $ 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 = do
+        src  <- generate $ AST.srcBlock mapSpec
+        dest <- generate $ AST.destNode mapSpec
+        base <- generate $ AST.destBase mapSpec
+        return $ predicate "map" [src, dest, base]
 
 instance PrologGenerator AST.NodeType where
-    generate = show 
+    generate AST.Memory = return $ atom "memory"
+    generate AST.Device = return $ atom "device"
+    generate AST.Other  = return $ atom "other"
 
-instance PrologGenerator AST.Addr where
-    generate (AST.Addr addr) = "16'" ++ showHex addr ""
+instance PrologGenerator AST.Address where
+    generate (AST.Address addr) = return $ "16'" ++ showHex addr ""
+
+instance PrologGenerator a => PrologGenerator [a] where
+    generate ast = do
+        let
+            mapped = map generate ast
+        return $ (list . catMaybes) mapped
 
 {- Helper functions -}
+atom :: String -> String
+atom name@(c:cs)
+    | isLower c && alphaNum cs = name
+    | otherwise = quotes name
+    where
+        alphaNum cs = foldl (\acc c -> isAlphaNum c && acc) True cs
+
 predicate :: String -> [String] -> String
 predicate name args = name ++ (parens $ intercalate "," args)
 
index d3a8dd6..3008a7c 100644 (file)
@@ -26,7 +26,7 @@ import Data.Map (Map)
 import qualified Data.Map as Map
 import Data.Maybe (fromMaybe, maybe)
 import Data.Set (Set)
-import qualified Data.Set
+import qualified Data.Set as Set
 
 import qualified SockeyeAST as AST
 import qualified SockeyeASTDecodingNet as NetAST
@@ -49,10 +49,10 @@ instance Show CheckFailure where
     show (CheckFailure fs) = unlines $ map show fs
 
 data Context = Context
-    { spec           :: AST.SockeyeSpec
-    , curNamespace   :: NetAST.Namespace
-    , paramValues    :: Map String Word
-    , varValues      :: Map String Word
+    { spec         :: AST.SockeyeSpec
+    , curNamespace :: NetAST.Namespace
+    , paramValues  :: Map String Word
+    , varValues    :: Map String Word
     }
 
 sockeyeBuildNet :: AST.SockeyeSpec -> Either CheckFailure NetAST.NetSpec
@@ -69,8 +69,10 @@ sockeyeBuildNet ast = do
         nodeIds = map fst net
     checkDuplicates nodeIds
     let
-        netSpec = Map.fromList net
-    check netSpec netSpec
+        nodeMap = Map.fromList net
+        symbols = Map.keysSet nodeMap
+        netSpec = NetAST.NetSpec $ nodeMap
+    check symbols netSpec
     return netSpec
 
 class NetTransformable a b where
@@ -186,7 +188,9 @@ instance NetTransformable AST.BlockSpec NetAST.BlockSpec where
     transform context (AST.LengthBlock base bits) =
         let
             netBase = transform context base
-            netLimit = netBase + 2^bits - 1
+            baseAddress = NetAST.address netBase
+            limit = baseAddress + 2^bits - 1
+            netLimit = NetAST.Address limit
         in NetAST.BlockSpec
             { NetAST.base  = netBase
             , NetAST.limit = netLimit
@@ -208,8 +212,8 @@ instance NetTransformable AST.MapSpec NetAST.MapSpec where
             }
 
 instance NetTransformable AST.Address NetAST.Address where
-    transform _ (AST.LiteralAddress value) = value
-    transform context (AST.ParamAddress name) = getParamValue context name
+    transform _ (AST.LiteralAddress value) = NetAST.Address value
+    transform context (AST.ParamAddress name) = NetAST.Address $ getParamValue context name
 
 instance NetTransformable a NetList => NetTransformable (AST.For a) NetList where
     transform context ast =
@@ -251,13 +255,17 @@ instance NetTransformable a NetList => NetTransformable [a] NetList where
     transform context ast = concat $ map (transform context) ast
 
 class NetCheckable a where
-    check :: NetAST.NetSpec -> a -> Either CheckFailure ()
+    check :: Set NetAST.NodeId -> a -> Either CheckFailure ()
 
 instance NetCheckable NetAST.NetSpec where
-    check context net = do
+    check context (NetAST.NetSpec net) = do
         check context $ Map.elems net
 
 instance NetCheckable NetAST.NodeSpec where
+    check context (NetAST.AliasSpec alias) = do
+        case alias of
+            Nothing -> return ()
+            Just ident -> check context ident
     check context net = do
         let
             translate = NetAST.translate net
@@ -273,7 +281,7 @@ instance NetCheckable NetAST.MapSpec where
 
 instance NetCheckable NetAST.NodeId where
     check context net = do
-        if net `Map.member` context
+        if net `Set.member` context
             then return ()
             else Left $ CheckFailure [UndefinedReference net]