--core <- GHC.compileToCoreSimplified "Adders.hs"
core <- GHC.compileToCoreSimplified "Adders.hs"
liftIO $ printBinds (cm_binds core)
- let bind = findBind "full_adder" (cm_binds core)
+ let bind = Maybe.fromJust $ findBind (cm_binds core) "full_adder"
let NonRec var expr = bind
-- Turn bind into VHDL
let vhdl = State.evalState (mkVHDL bind) (VHDLSession 0 builtin_funcs)
--putStr $ showSDoc $ ppr expr
putStr "\n"
-findBind :: String -> [CoreBind] -> CoreBind
-findBind lookfor =
+findBind :: [CoreBind] -> String -> Maybe CoreBind
+findBind binds lookfor =
-- This ignores Recs and compares the name of the bind with lookfor,
-- disregarding any namespaces in OccName and extra attributes in Name and
-- Var.
- Maybe.fromJust . find (\b -> case b of
+ find (\b -> case b of
Rec l -> False
NonRec var _ -> lookfor == (occNameString $ nameOccName $ getName var)
- )
+ ) binds
getPortMapEntry ::
SignalNameMap AST.VHDLId -- The port name to bind to
(error $ "Argument " ++ getOccString id ++ "is unknown")
(lookup id binds)
+expandExpr binds l@(Let (NonRec b bexpr) expr) = do
+ (signal_decls, statements, arg_signals, res_signals) <- expandExpr binds bexpr
+ let binds' = (b, res_signals) : binds
+ (signal_decls', statements', arg_signals', res_signals') <- expandExpr binds' expr
+ return (
+ signal_decls ++ signal_decls',
+ statements ++ statements',
+ arg_signals',
+ res_signals')
+
expandExpr binds app@(App _ _) = do
let ((Var f), args) = collectArgs app
if isTupleConstructor f
createSignalAssignments (Tuple dsts) (Tuple srcs) =
concat $ zipWith createSignalAssignments dsts srcs
+createSignalAssignments dst src =
+ error $ "Non matching source and destination: " ++ show dst ++ "\nand\n" ++ show src
+
data SignalNameMap t =
Tuple [SignalNameMap t]
| Signal t