X-Git-Url: https://git.stderr.nl/gitweb?a=blobdiff_plain;f=Translator.hs;h=c96bebce5e5cd1eca842ff4645af848663a42000;hb=358a33adc0f4328d1908938952d2edef85e75546;hp=f16f40f2d6f63f4a42f4f73f86480cc312896715;hpb=33c032737b6c84ff5075567d90f4dd2d830dafd6;p=matthijs%2Fmaster-project%2Fc%CE%BBash.git

diff --git a/Translator.hs b/Translator.hs
index f16f40f..c96bebc 100644
--- 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
@@ -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")),