Hi All
I can make a list of unboxed ints like below:
{-# LANGUAGE MagicHash #-}
import GHC.Exts (Int#, Float#)
data IntList = IntTail | IntNode Int# IntList
intListLength :: IntList -> Int
intListLength IntTail = 0
intListLength (IntNode _ rest) = 1 + intListLength rest
I can then make a list of unboxed floats similarly:
data FloatList = FloatTail | FloatNode Int# FloatList
floatListLength :: FloatList -> Int
floatListLength FloatTail = 0
floatListLength (FloatNode _ rest) = 1 + floatListLength rest
But as you can see, this is getting a bit copy-pasta, which is not good. So instead, lets try this:
newtype GeneralList (a :: l) = Tail | Node a (GeneralList a)
This is not allowed here, I believe because `GeneralList` is expected to have one representation for all `a`, instead of a representation which depends on `a`. This is so that if one writes a function:
generalListLength :: GeneralList a -> Int
generalListLength Tail = 0
generalListLength (Node _ rest) = 1 + generalListLength rest
You can't actually compile this into one function, because the relative location of the "next" pointer can change based on the size of `a` (assuming `a` is stored first).
However, I can achieve what I want with copy pasting or Template Haskell hackery.
Is there a way to get GHC to do the copy pasting for me? Or do I have to make a choice between extra runtime indirection and avoiding ugly code or having ugly code but avoiding the runtime indirection? A representation polymorphic list here is something that languages like C++, Rust, and even C# will handle happily, so Haskell seems behind here unless I'm missing something,