- :: DataCon -- the con we're matching on
- -> [Id] -- the source-level args
- -> [StrictnessMark] -- the strictness annotations (per-arg)
- -> CoreExpr -- the body
- -> Int -- template local
- -> (CoreExpr, [Id])
-
-rebuildConArgs con [] stricts body i = (body, [])
-rebuildConArgs con (arg:args) stricts body i | isTyVar arg
- = let (body', args') = rebuildConArgs con args stricts body i
- in (body',arg:args')
-rebuildConArgs con (arg:args) (str:stricts) body i
- = case maybeMarkedUnboxed str of
- Just (pack_con1, _) ->
- case splitProductType_maybe (idType arg) of
- Just (_, tycon_args, pack_con, con_arg_tys) ->
- ASSERT( pack_con == pack_con1 )
- let unpacked_args = zipWith mkTemplateLocal [i..] con_arg_tys
- (body', real_args) = rebuildConArgs con args stricts body
- (i + length con_arg_tys)
- in
- (
- Let (NonRec arg (mkConApp pack_con
- (map Type tycon_args ++
- map Var unpacked_args))) body',
- unpacked_args ++ real_args
- )
-
- _ -> let (body', args') = rebuildConArgs con args stricts body i
- in (body', arg:args')
+ :: [Id] -- Source-level args
+ -> [StrictnessMark] -- Strictness annotations (per-arg)
+ -> [Unique] -- Uniques for the new Ids
+ -> ([CoreBind], [Id]) -- A binding for each source-level arg, plus
+ -- a list of the representation-level arguments
+-- e.g. data T = MkT Int !Int
+--
+-- rebuild [x::Int, y::Int] [Not, Unbox]
+-- = ([ y = I# t ], [x,t])
+
+rebuildConArgs [] stricts us = ([], [])
+
+-- Type variable case
+rebuildConArgs (arg:args) stricts us
+ | isTyVar arg
+ = let (binds, args') = rebuildConArgs args stricts us
+ in (binds, arg:args')
+
+-- Term variable case
+rebuildConArgs (arg:args) (str:stricts) us
+ | isMarkedUnboxed str
+ = let
+ arg_ty = idType arg
+
+ (_, tycon_args, pack_con, con_arg_tys)
+ = splitProductType "rebuildConArgs" arg_ty
+
+ unpacked_args = zipWith (mkSysLocal SLIT("rb")) us con_arg_tys
+ (binds, args') = rebuildConArgs args stricts (drop (length con_arg_tys) us)
+ con_app = mkConApp pack_con (map Type tycon_args ++ map Var unpacked_args)
+ in
+ (NonRec arg con_app : binds, unpacked_args ++ args')
+
+ | otherwise
+ = let (binds, args') = rebuildConArgs args stricts us
+ in (binds, arg:args')