+ error $ "Unsupported expression" ++ (showSDoc $ ppr $ expr)
+
+expandExpr ::
+ [(CoreBndr, SignalNameMap AST.VHDLName)]
+ -- A list of bindings in effect
+ -> CoreExpr -- The expression to expand
+ -> VHDLState (
+ [AST.SigDec], -- Needed signal declarations
+ [AST.ConcSm], -- Needed component instantations and
+ -- signal assignments.
+ [SignalNameMap AST.VHDLId], -- The signal names corresponding to
+ -- the expression's arguments
+ SignalNameMap AST.VHDLId) -- The signal names corresponding to
+ -- the expression's result.
+expandExpr binds (Lam b expr) = do
+ -- Generate a new signal to which we will expect this argument to be bound.
+ signal_name <- uniqueName ("arg-" ++ getOccString b)
+ let (signal_id, signal_decl) = mkSignal signal_name vhdl_bit_ty
+ -- Add the binder to the list of binds
+ let binds' = (b, Signal (AST.NSimple signal_id)) : binds
+ -- Expand the rest of the expression
+ (signal_decls, statements, arg_signals, res_signal) <- expandExpr binds' expr
+ -- Properly merge the results
+ return (signal_decl : signal_decls,
+ statements,
+ (Signal signal_id) : arg_signals,
+ res_signal)
+
+expandExpr binds (Var id) =
+ return ([], [], [], Signal signal_id)
+ where
+ -- Lookup the id in our binds map
+ Signal (AST.NSimple signal_id) = Maybe.fromMaybe
+ (error $ "Argument " ++ getOccString id ++ "is unknown")
+ (lookup id binds)
+
+-- Generate a signal declaration for a signal with the given name and the
+-- given type and no value. Also returns the id of the signal.
+mkSignal :: String -> AST.TypeMark -> (AST.VHDLId, AST.SigDec)
+mkSignal name ty =
+ (id, AST.SigDec id ty Nothing)
+ where
+ id = AST.unsafeVHDLBasicId name
+
+expandArgs ::
+ [(CoreBndr, SignalNameMap AST.VHDLId)] -- A list of bindings in effect
+ -> [CoreExpr] -- The arguments to expand
+ -> VHDLState ([AST.SigDec], [AST.ConcSm], [AST.VHDLName])
+ -- The resulting signal declarations,
+ -- component instantiations and a
+ -- VHDLName for each of the
+ -- expressions passed in.
+expandArgs binds (e:exprs) = do
+ -- Expand the first expression
+ arg <- case e of
+ -- A simple variable reference should be in our binds map
+ Var id -> return $ let
+ -- Lookup the id in our binds map
+ Signal signalid = Maybe.fromMaybe
+ (error $ "Argument " ++ getOccString id ++ "is unknown")
+ (lookup id binds)
+ in
+ -- Create a VHDL name from the signal name
+ AST.NSimple signalid
+ -- Other expressions are unsupported
+ otherwise -> error ("Unsupported expression used as argument: " ++ (showSDoc $ ppr e))
+ -- Expand the rest
+ (sigs, comps, args) <- expandArgs binds exprs
+ -- Return all results
+ return (sigs, comps, arg:args)
+
+expandArgs _ [] = return ([], [], [])