[Git][ghc/ghc][wip/buggymcbugfix/arrayOf-primop] 3 commits: Syntax fix
Vilem-Benjamin Liepelt
gitlab at gitlab.haskell.org
Tue Sep 1 13:05:21 UTC 2020
Vilem-Benjamin Liepelt pushed to branch wip/buggymcbugfix/arrayOf-primop at Glasgow Haskell Compiler / GHC
Commits:
7041494a by buggymcbugfix at 2020-09-01T15:03:58+02:00
Syntax fix
- - - - -
5ffc53b6 by buggymcbugfix at 2020-09-01T15:03:58+02:00
Point to some useful background information
- - - - -
6c271b32 by buggymcbugfix at 2020-09-01T15:04:53+02:00
Implement `arrayOf#`
- - - - -
5 changed files:
- compiler/GHC/Builtin/primops.txt.pp
- compiler/GHC/StgToCmm/Closure.hs
- compiler/GHC/StgToCmm/Prim.hs
- docs/users_guide/exts/template_haskell.rst
- libraries/ghc-prim/GHC/Tuple.hs
Changes:
=====================================
compiler/GHC/Builtin/primops.txt.pp
=====================================
@@ -1247,9 +1247,15 @@ primop NewSmallArrayOp "newSmallArray#" GenPrimOp
out_of_line = True
has_side_effects = True
+primop ArrayOfOp "arrayOf#" GenPrimOp
+ o -> Array# b
+ {arrayOf# :: (# a, .., a #) -> Array# a}
+ with
+ has_side_effects = True
+
primop SmallArrayOfOp "smallArrayOf#" GenPrimOp
o -> SmallArray# b
- {smallArrayOf# :: (# a, .., a #) -> Array# a}
+ {smallArrayOf# :: (# a, .., a #) -> SmallArray# a}
with
has_side_effects = True
=====================================
compiler/GHC/StgToCmm/Closure.hs
=====================================
@@ -60,7 +60,6 @@ module GHC.StgToCmm.Closure (
cafBlackHoleInfoTable,
indStaticInfoTable,
staticClosureNeedsLink,
- smallArrayStaticInfoTable,
) where
#include "HsVersions.h"
@@ -987,14 +986,6 @@ indStaticInfoTable
, cit_srt = Nothing
, cit_clo = Nothing }
-smallArrayStaticInfoTable :: WordOff -> CmmInfoTable
-smallArrayStaticInfoTable n
- = CmmInfoTable { cit_lbl = mkSMAP_FROZEN_DIRTY_infoLabel
- , cit_rep = smallArrPtrsRep (fromIntegral n)
- , cit_prof = NoProfilingInfo
- , cit_srt = Nothing
- , cit_clo = Nothing }
-
staticClosureNeedsLink :: Bool -> CmmInfoTable -> Bool
-- A static closure needs a link field to aid the GC when traversing
-- the static closure graph. But it only needs such a field if either
=====================================
compiler/GHC/StgToCmm/Prim.hs
=====================================
@@ -1,5 +1,6 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE ScopedTypeVariables #-}
#if __GLASGOW_HASKELL__ <= 808
-- GHC 8.10 deprecates this flag, but GHC 8.8 needs it
@@ -58,7 +59,6 @@ import Data.Bits ((.&.), bit)
import Control.Monad (liftM, when, unless)
import GHC.Types.CostCentre (dontCareCCS)
-import GHC.StgToCmm.Closure
------------------------------------------------------------------------
-- Primitive operations and foreign calls
@@ -244,27 +244,9 @@ emitPrimOp dflags = \case
(replicate (fromIntegral n) init)
_ -> PrimopCmmEmit_External
- op at SmallArrayOfOp -> \elems -> opAllDone $ \[res] -> do
- let n = length elems
- case allStatic elems of
- Just known -> do
- u <- newUnique
- let lbl = mkUnliftedDataLabel u op
- emitDataCon lbl (smallArrayStaticInfoTable n) dontCareCCS known
- emit $ mkAssign (CmmLocal res) (CmmLit $ CmmLabel lbl)
- Nothing -> doNewArrayOp
- res
- (smallArrPtrsRep (fromIntegral n))
- mkSMAP_FROZEN_DIRTY_infoLabel
- [ ( mkIntExpr platform n
- , fixedHdrSize dflags + oFFSET_StgSmallMutArrPtrs_ptrs dflags ) ]
- elems
- where
- -- todo: comment
- allStatic = foldr step (Just [])
+ op at ArrayOfOp -> doArrayOfOp dflags op
- step (CmmLit l) (Just acc) = Just (l : acc) -- c.f. XXX getLit
- step _ _ = Nothing
+ op at SmallArrayOfOp -> doArrayOfOp dflags op
CopySmallArrayOp -> \case
[src, src_off, dst, dst_off, (CmmLit (CmmInt n _))] ->
@@ -2583,6 +2565,61 @@ doNewArrayOp res_r rep info payload inits = do
emit $ mkAssign (CmmLocal res_r) (CmmReg arr)
+doArrayOfOp :: DynFlags -> PrimOp -> [CmmExpr] -> PrimopCmmEmit
+doArrayOfOp dflags op = \elems -> PrimopCmmEmit_IntoRegs $ \[res] -> do
+ let
+ n :: Int
+ n = length elems
+
+ platform :: Platform
+ platform = targetPlatform dflags
+
+ infoTbl :: CmmInfoTable
+ infoTbl = CmmInfoTable
+ { cit_lbl = lbl
+ , cit_rep = rep
+ , cit_prof = NoProfilingInfo
+ , cit_srt = Nothing
+ , cit_clo = Nothing }
+
+ lbl :: CLabel
+ rep :: SMRep
+ hdr :: [(CmmExpr, ByteOff)]
+ (lbl, rep, hdr) = case op of
+ ArrayOfOp ->
+ ( mkMAP_FROZEN_DIRTY_infoLabel
+ , arrPtrsRep dflags (fromIntegral n)
+ , [ ( mkIntExpr platform n
+ , fixedHdrSize dflags + oFFSET_StgMutArrPtrs_ptrs dflags )
+ , ( mkIntExpr platform (nonHdrSizeW (arrPtrsRep dflags n))
+ , fixedHdrSize dflags + oFFSET_StgMutArrPtrs_size dflags )
+ ]
+ )
+ SmallArrayOfOp ->
+ ( mkSMAP_FROZEN_DIRTY_infoLabel
+ , smallArrPtrsRep (fromIntegral n)
+ , [ ( mkIntExpr platform n
+ , fixedHdrSize dflags + oFFSET_StgSmallMutArrPtrs_ptrs dflags
+ )
+ ]
+ )
+ _ -> error "Expected one of: ArrayOfOp, SmallArrayOfOp"
+
+ if all isStatic elems
+ then do
+ u <- newUnique
+ let staticLbl = mkUnliftedDataLabel u op
+ emitDataCon staticLbl infoTbl dontCareCCS (map unsafeUnwrapLit elems)
+ emit $ mkAssign (CmmLocal res) (CmmLit $ CmmLabel staticLbl)
+ else doNewArrayOp res rep lbl hdr elems
+
+isStatic :: CmmExpr -> Bool
+isStatic = \case CmmLit{} -> True; _ -> False
+
+unsafeUnwrapLit :: CmmExpr -> CmmLit
+unsafeUnwrapLit (CmmLit i) = i
+unsafeUnwrapLit _ = error "Expected CmmLit"
+
-- ----------------------------------------------------------------------------
-- Copying pointer arrays
=====================================
docs/users_guide/exts/template_haskell.rst
=====================================
@@ -115,7 +115,7 @@ The :extension:`TemplateHaskellQuotes` extension is considered safe under
-- monad used to build the representation are propagated when using nested
-- splices.
f :: (Quote m, C m) => m Exp
- f = [| 5 | ]
+ f = [| 5 |]
-- f is used in a nested splice so the constraint on f, namely C, is propagated
-- to a constraint on the whole representation.
@@ -769,5 +769,3 @@ Run "main" and here is your output:
$ ./main
3
1
-
-
=====================================
libraries/ghc-prim/GHC/Tuple.hs
=====================================
@@ -5,7 +5,7 @@
-- Module : GHC.Tuple
-- Copyright : (c) The University of Glasgow 2001
-- License : BSD-style (see the file libraries/ghc-prim/LICENSE)
---
+--
-- Maintainer : libraries at haskell.org
-- Stability : experimental
-- Portability : non-portable (GHC extensions)
@@ -167,6 +167,8 @@ data (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h
= (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1,n1,o1,p1,q1,
r1,s1,t1,u1,v1,w1,x1,y1,z1,a2,b2,c2,d2,e2,f2,g2,h2,i2,j2)
+-- [Why are GHC tuples limited to size 62?](https://stackoverflow.com/a/46416136)
+
{- Manuel says: Including one more declaration gives a segmentation fault.
data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__
= (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__
@@ -238,7 +240,7 @@ data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
= (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__ z__ a___ b___ c___ d___ e___ f___ g___ h___ i___ j___ k___ l___ m___ n___ o___ p___ q___ r___
data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__ z__ a___ b___ c___ d___ e___ f___ g___ h___ i___ j___ k___ l___ m___ n___ o___ p___ q___ r___ s___
= (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__ z__ a___ b___ c___ d___ e___ f___ g___ h___ i___ j___ k___ l___ m___ n___ o___ p___ q___ r___ s___
-data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__ z__ a___ b___ c___ d___ e___ f___ g___ h___ i___ j___ k___ l___ m___ n___ o___ p___ q___ r___ s___ t___
+data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__ z__ a___ b___ c___ d___ e___ f___ g___ h___ i___ j___ k___ l___ m___ n___ o___ p___ q___ r___ s___ t___
= (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__ z__ a___ b___ c___ d___ e___ f___ g___ h___ i___ j___ k___ l___ m___ n___ o___ p___ q___ r___ s___ t___
data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__ z__ a___ b___ c___ d___ e___ f___ g___ h___ i___ j___ k___ l___ m___ n___ o___ p___ q___ r___ s___ t___ u___
= (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__ z__ a___ b___ c___ d___ e___ f___ g___ h___ i___ j___ k___ l___ m___ n___ o___ p___ q___ r___ s___ t___ u___
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/9995769c61751476e33a6f17ee307045cd9cb9bc...6c271b3240657f3d4c55e3a927fc7fd3bf342447
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/9995769c61751476e33a6f17ee307045cd9cb9bc...6c271b3240657f3d4c55e3a927fc7fd3bf342447
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20200901/3078ec66/attachment-0001.html>
More information about the ghc-commits
mailing list