diff options
| author | Matthew Craven <5086-clyring@users.noreply.gitlab.haskell.org> | 2023-04-17 23:08:21 -0400 |
|---|---|---|
| committer | Matthew Craven <5086-clyring@users.noreply.gitlab.haskell.org> | 2023-04-17 23:08:21 -0400 |
| commit | 745b3f7e502c0ffd1410f46524d317cb97c5daf8 (patch) | |
| tree | 83ebd3a22406f7e42f92aaabc81f4e7c64c6eda9 | |
| parent | ee5510b9747bd8783fe2bd8513d4f98c7f93a438 (diff) | |
| download | haskell-wip/zap-void-StgOpApp-args.tar.gz | |
filter out voidrep args in collectStgFArgTypeswip/zap-void-StgOpApp-args
| -rw-r--r-- | compiler/GHC/StgToCmm/Foreign.hs | 21 |
1 files changed, 12 insertions, 9 deletions
diff --git a/compiler/GHC/StgToCmm/Foreign.hs b/compiler/GHC/StgToCmm/Foreign.hs index 0a902a520a..603eb49782 100644 --- a/compiler/GHC/StgToCmm/Foreign.hs +++ b/compiler/GHC/StgToCmm/Foreign.hs @@ -720,20 +720,23 @@ collectStgFArgTypes = go [] go _ (CastTy{}) = panic "myCollectTypeArgs: CastTy" go _ (CoercionTy{}) = panic "myCollectTypeArgs: CoercionTy" go bs (FunTy {ft_arg = arg, ft_res=res}) = - go (typeToStgFArgType arg:bs) res + case typeToStgFArgType arg of + Just b -> go (b : bs) res + Nothing -> go bs res -- Choose the offset based on the type. For anything other -- than an unlifted boxed type, there is no offset. -- See Note [Unlifted boxed arguments to foreign calls] -typeToStgFArgType :: Type -> StgFArgType +typeToStgFArgType :: Type -> Maybe StgFArgType typeToStgFArgType typ - | tycon == arrayPrimTyCon = StgArrayType - | tycon == mutableArrayPrimTyCon = StgArrayType - | tycon == smallArrayPrimTyCon = StgSmallArrayType - | tycon == smallMutableArrayPrimTyCon = StgSmallArrayType - | tycon == byteArrayPrimTyCon = StgByteArrayType - | tycon == mutableByteArrayPrimTyCon = StgByteArrayType - | otherwise = StgPlainType + | tycon == arrayPrimTyCon = Just StgArrayType + | tycon == mutableArrayPrimTyCon = Just StgArrayType + | tycon == smallArrayPrimTyCon = Just StgSmallArrayType + | tycon == smallMutableArrayPrimTyCon = Just StgSmallArrayType + | tycon == byteArrayPrimTyCon = Just StgByteArrayType + | tycon == mutableByteArrayPrimTyCon = Just StgByteArrayType + | isZeroBitTy typ = Nothing + | otherwise = Just StgPlainType where -- Should be a tycon app, since this is a foreign call. We look -- through newtypes so the offset does not change if a user replaces |