- case (Map.lookup (bndrToString f) funSignatures) of
- Just funSignature ->
- let
- sigs = map (bndrToString.varBndr) args
- sigsNames = map (\signal -> (AST.PrimName (AST.NSimple (mkVHDLExtId signal)))) sigs
- func = (snd funSignature) sigsNames
- src_wform = AST.Wform [AST.WformElem func Nothing]
- dst_name = AST.NSimple (mkVHDLExtId (bndrToString bndr))
- assign = dst_name AST.:<==: (AST.ConWforms [] src_wform Nothing)
- in
- return $ AST.CSSASm assign
- Nothing ->
+ let valargs' = filter isValArg args
+ let valargs = filter (\(CoreSyn.Var bndr) -> not (Id.isDictId bndr)) valargs'
+ case Var.globalIdVarDetails f of
+ IdInfo.DataConWorkId dc ->
+ -- It's a datacon. Create a record from its arguments.
+ -- First, filter out type args. TODO: Is this the best way to do this?
+ -- The types should already have been taken into acocunt when creating
+ -- the signal, so this should probably work...
+ --let valargs = filter isValArg args in
+ if all is_var valargs then do
+ labels <- getFieldLabels (CoreUtils.exprType app)
+ return $ zipWith mkassign labels valargs
+ else
+ error $ "VHDL.mkConcSm Not in normal form: One ore more complex arguments: " ++ pprString args
+ where
+ mkassign :: AST.VHDLId -> CoreExpr -> AST.ConcSm
+ mkassign label (Var arg) =
+ let sel_name = mkSelectedName bndr label in
+ mkUncondAssign (Right sel_name) (varToVHDLExpr arg)
+ IdInfo.VanillaGlobal -> do
+ -- It's a global value imported from elsewhere. These can be builtin
+ -- functions.
+ funSignatures <- getA vsNameTable
+ entSignatures <- getA vsSignatures
+ case (Map.lookup (bndrToString f) funSignatures) of
+ Just (arg_count, builder) ->
+ if length valargs == arg_count then
+ case builder of
+ Left funBuilder ->
+ let
+ sigs = map (bndrToString.varBndr) valargs
+ sigsNames = map (\signal -> (AST.PrimName (AST.NSimple (mkVHDLExtId signal)))) sigs
+ func = funBuilder sigsNames
+ src_wform = AST.Wform [AST.WformElem func Nothing]
+ dst_name = AST.NSimple (mkVHDLExtId (bndrToString bndr))
+ assign = dst_name AST.:<==: (AST.ConWforms [] src_wform Nothing)
+ in
+ return [AST.CSSASm assign]
+ Right genBuilder ->
+ let
+ sigs = map (varBndr) valargs
+ signature = Maybe.fromMaybe
+ (error $ "Using function '" ++ (bndrToString (head sigs)) ++ "' without signature? This should not happen!")
+ (Map.lookup (head sigs) entSignatures)
+ arg_name = mkVHDLExtId (bndrToString (last sigs))
+ dst_name = mkVHDLExtId (bndrToString bndr)
+ genSm = genBuilder 4 signature [arg_name, dst_name]
+ in return [AST.CSGSm genSm]
+ else
+ error $ "VHDL.mkConcSm Incorrect number of arguments to builtin function: " ++ pprString f ++ " Args: " ++ pprString valargs
+ Nothing -> error $ "Using function from another module that is not a known builtin: " ++ pprString f
+ IdInfo.NotGlobalId -> do
+ signatures <- getA vsSignatures
+ -- This is a local id, so it should be a function whose definition we
+ -- have and which can be turned into a component instantiation.