Jaro Reinders pushed to branch wip/reduce-type-in-stg at Glasgow Haskell Compiler / GHC

Commits:

2 changed files:

Changes:

  • compiler/GHC/Stg/Syntax.hs
    ... ... @@ -993,8 +993,7 @@ pprStgOp :: StgOp -> SDoc
    993 993
     pprStgOp (StgPrimOp  op)   = ppr op
    
    994 994
     pprStgOp (StgPrimCallOp op _)= ppr op
    
    995 995
     pprStgOp (StgFCallOp op _ _) = ppr op
    
    996
    --- TODO: how do we want to pretty print this?
    
    997
    -pprStgOp (StgTagToEnumOp tyc) = text "TagToEnumOp" <+> ppr tyc
    
    996
    +pprStgOp (StgTagToEnumOp _tyc) = text "tagToEnum#"
    
    998 997
     
    
    999 998
     instance Outputable StgOp where
    
    1000 999
       ppr = pprStgOp
    

  • compiler/GHC/StgToJS/FFI.hs
    ... ... @@ -184,7 +184,7 @@ genForeignCall _ctx
    184 184
                    (CCall (CCallSpec (StaticTarget ext tgt ForeignFunction)
    
    185 185
                                        JavaScriptCallConv
    
    186 186
                                        PlayRisky))
    
    187
    -               _t
    
    187
    +               _ki
    
    188 188
                    [obj]
    
    189 189
                    args
    
    190 190
       | tgt == hdBuildObjectStr
    
    ... ... @@ -195,12 +195,9 @@ genForeignCall _ctx
    195 195
                  , ExprInline
    
    196 196
                  )
    
    197 197
     
    
    198
    -genForeignCall ctx (CCall (CCallSpec ccTarget cconv safety)) k tgt args = do
    
    199
    -  -- TODO: the 'unknown' here was originally the type constructor shown by 'showType'
    
    200
    -  -- but now we don't have access to that any more. I'm not sure if this is necessary
    
    201
    -  -- for the JS back end.
    
    202
    -  emitForeign (ctxSrcSpan ctx) lbl safety cconv (map showArgType args) unknown
    
    203
    -  (,exprResult) <$> parseFFIPattern catchExcep async isJsCc (unpackFS lbl) k tgt' args
    
    198
    +genForeignCall ctx (CCall (CCallSpec ccTarget cconv safety)) ki tgt args = do
    
    199
    +  emitForeign (ctxSrcSpan ctx) lbl safety cconv (map showArgType args) (showType (getStgKind ki))
    
    200
    +  (,exprResult) <$> parseFFIPattern catchExcep async isJsCc (unpackFS lbl) ki tgt' args
    
    204 201
       where
    
    205 202
         isJsCc = cconv == JavaScriptCallConv
    
    206 203