Look up the port names in the session when generating an architecture.

[matthijs/master-project/cλash.git] / Translator.hs

diff --git a/Translator.hs b/Translator.hs
index b18a86fd1cd939b6850a246a45f7feec49c2a651..c96bebce5e5cd1eca842ff4645af848663a42000 100644 (file)
--- a/Translator.hs
+++ b/Translator.hs
@@ -43,6 +43,8 @@ main =
                                        let bind = findBind "half_adder" (cm_binds core)
                                        let NonRec var expr = bind
                                        let sess = VHDLSession 0 builtin_funcs
+                                       let (sess', name, f) = mkHWFunction sess bind
+                                       let sess = addFunc sess' name f
                                        liftIO $ putStr $ showSDoc $ ppr expr
                                        liftIO $ putStr "\n\n"
                                        liftIO $ putStr $ render $ ForSyDe.Backend.Ppr.ppr $ getArchitecture sess bind
@@ -146,10 +148,10 @@ getInstantiations sess args outs binds app@(App expr arg) =
                hwfunc = Maybe.fromMaybe
                        (error $ "Function " ++ compname ++ "is unknown")
                        (lookup compname (funcs sess))
-               HWFunction inports outports = hwfunc
+               HWFunction (Args inports) outport = hwfunc
                ports = 
-                       zipWith (getPortMapEntry binds) [Port "portin0", Port "portin1"] fargs
-                 ++ mapOutputPorts outports outs
+                       zipWith (getPortMapEntry binds) inports fargs
+                 ++ mapOutputPorts outport outs
 
 getInstantiations sess args outs binds expr = 
        error $ "Unsupported expression" ++ (showSDoc $ ppr $ expr)
@@ -203,17 +205,13 @@ getArchitecture sess (NonRec var expr) =
                -- Use unsafe for now, to prevent pulling in ForSyDe error handling
                (AST.NSimple (AST.unsafeVHDLBasicId name))
                []
-               (getInstantiations sess (Args inportnames) outport [] expr)
+               (getInstantiations sess (Args inports) outport [] expr)
        where
                name = (getOccString var)
-               ty = CoreUtils.exprType expr
-               (fargs, res) = Type.splitFunTys ty
-               --state = if length fargs == 1 then () else (last fargs)
-               ports = if length fargs == 1 then fargs else (init fargs)
-               inportnames = case ports of
-                       [port] -> [getPortNameMapForTy "portin" port]
-                       ps     -> getPortNameMapForTys "portin" 0 ps
-               outport = getPortNameMapForTy "portout" res
+               hwfunc = Maybe.fromMaybe
+                       (error $ "Function " ++ name ++ "is unknown? This should not happen!")
+                       (lookup name (funcs sess))
+               HWFunction (Args inports) outport = hwfunc
 
 data PortNameMap =
        Args [PortNameMap] -- Each of the submaps represent an argument to the
@@ -245,11 +243,40 @@ data HWFunction = HWFunction { -- A function that is available in hardware
        --entity    :: AST.EntityDec
 }
 
+-- Turns a CoreExpr describing a function into a description of its input and
+-- output ports.
+mkHWFunction ::
+       VHDLSession
+       -> CoreBind                                -- The core binder to generate the interface for
+       -> (VHDLSession, String, HWFunction)       -- The name of the function and its interface
+
+mkHWFunction sess (NonRec var expr) =
+       (sess, name, HWFunction (Args inports) outport)
+       where
+               name = (getOccString var)
+               ty = CoreUtils.exprType expr
+               (fargs, res) = Type.splitFunTys ty
+               args = if length fargs == 1 then fargs else (init fargs)
+               --state = if length fargs == 1 then () else (last fargs)
+               inports = case args of
+                       -- Handle a single port specially, to prevent an extra 0 in the name
+                       [port] -> [getPortNameMapForTy "portin" port]
+                       ps     -> getPortNameMapForTys "portin" 0 ps
+               outport = getPortNameMapForTy "portout" res
+
+mkHWFunction sess (Rec _) =
+       error "Recursive binders not supported"
+
 data VHDLSession = VHDLSession {
        nameCount :: Int,                      -- A counter that can be used to generate unique names
        funcs     :: [(String, HWFunction)]    -- All functions available, indexed by name
 }
 
+-- Add the function to the session
+addFunc :: VHDLSession -> String -> HWFunction -> VHDLSession
+addFunc sess name f =
+       sess {funcs = (name, f) : (funcs sess) }
+
 builtin_funcs = 
        [ 
                ("hwxor", HWFunction (Args [Port "a", Port "b"]) (Port "o")),