+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)
+
+expandExpr binds expr =
+ error $ "Unsupported expression: " ++ (showSDoc $ ppr $ expr)
+
+-- 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
+