Skip to content

WIP: Variadic `smallArrayOf#` primop

Vilem-Benjamin Liepelt requested to merge wip/buggymcbugfix/arrayOf-primop into master

Replaces !3372 (closed). Adds primitives for allocating arbitary size arrays from a list of arguments (represented as an n-ary, possibly nested unboxed tuple). Furthermore we make this a static allocation into the data section when all the elements are known.

So far only implemented for SmallArray because of a concrete use cases in unordered-containers.

Example usage:

{-# LANGUAGE MagicHash #-}
{-# LANGUAGE UnboxedTuples #-}

module Main (arrs) where

import GHC.Exts

data A = A !(SmallArray# Bool)

arrs :: [A]
arrs =
    [ A (smallArrayOf# True)
    , A (smallArrayOf# (# #))
    , A (smallArrayOf# (# False, True #))
    , A (smallArrayOf# (# (# #), (# False, True #) #)) -- same as previous
    ]

We exploit the unarise stg->stg pass in conjunction with rep polymorphism to essentially get a variadic primop, as unarise flattens and "curries" functions taking unboxed array arguments. At the stg level, primops must be fully applied. Admittedly things fall together in a rather felicitous way to allow us to do this; so is this a hack? I would argue no, as these aspects are all a fundamental part of the design of GHC.

Morally the primop we introduce should have type smallArrayOf# :: forall (a :: Type). (# a, ... #) -> SmallArray# a.

The actual, unsafe type is smallArrayOf# :: forall r (a :: TYPE r) b. a -> SmallArray# b, as GHC's kind system doesn't currently allow us to express the kind "n-ary unboxed tuple of lifted elements", as far as I know. We leave it up to library code to define safe wrappers. One possible such wrapper could be:

class Variadic a (as :: TYPE (r :: RuntimeRep)) where
instance Variadic a (# #)
instance Variadic a (# a #)
instance Variadic a (# a, a #)
instance Variadic a (# a, a, a #)
-- ... ad 62
instance (Variadic a as, Variadic a as') => Variadic a (# as, as' #)
-- ... etc

arrayOf :: Variadic a as => as -> Array a
arrayOf xs = Array (arrayOf# xs)

We have tested the implementation with thousands of arguments so it seems robust in this respect.

Open Questions / TODOs

  • We probably ought to make arrayOf# look expensive to the inliner? Perhaps depending on size?
    • Need to consider how we want this to interact with constant folding.
    • @AndreasK says this is not an issue.
  • Finish SRT generation in Build.hs (useful link for my own reference: https://simonmar.github.io/posts/2018-06-22-New-SRTs.html)
  • Implement for Array#
  • Write tests
  • GHC Proposal
Edited by Vilem-Benjamin Liepelt

Merge request reports