Skip to content

Instantly share code, notes, and snippets.

Embed
What would you like to do?
But Why Though
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE UnboxedTuples #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
import Control.Monad
import Control.Exception
import GHC.Exts
import GHC.IO
import GHC.Prim
import System.IO.Unsafe
data UntypedArray =
UntypedArray
{ _size :: Int#
, _array :: SmallArray# Any
}
empty :: UntypedArray
empty =
unsafePerformIO $! IO $ \s0 ->
case newSmallArray# 0# (error "empty") s0 of
(# s1, arr0 #) ->
case unsafeFreezeSmallArray# arr0 s1 of
(# s2, arr1 #) -> (# s2, UntypedArray 0# arr1 #)
append :: UntypedArray -> a -> UntypedArray
append (UntypedArray size arr0) a =
let
newSize = size +# 1#
in
unsafePerformIO $! IO $ \s0 ->
case newSmallArray# newSize (error "append") s0 of
(# s1, arr1 #) ->
case copySmallArray# arr0 0# arr1 0# size s1 of
s2 ->
case writeSmallArray# arr1 size (unsafeCoerce# a) s2 of
s3 ->
case unsafeFreezeSmallArray# arr1 s3 of
(# s4, arr2 #) -> (# s4, UntypedArray newSize arr2 #)
infixl 5 |>
(|>) :: UntypedArray -> a -> UntypedArray
(|>) = append
prepend :: a -> UntypedArray -> UntypedArray
prepend a (UntypedArray size arr0) =
let
newSize = size +# 1#
in
unsafePerformIO $! IO $ \s0 ->
case newSmallArray# newSize (error "prepend") s0 of
(# s1, arr1 #) ->
case copySmallArray# arr0 0# arr1 1# size s1 of
s2 ->
case writeSmallArray# arr1 0# (unsafeCoerce# a) s2 of
s3 ->
case unsafeFreezeSmallArray# arr1 s3 of
(# s4, arr2 #) -> (# s4, UntypedArray newSize arr2 #)
infixr 5 <|
(<|) :: a -> UntypedArray -> UntypedArray
(<|) = prepend
get :: forall a. Int -> UntypedArray -> a
get (I# index) (UntypedArray _ arr0) =
unsafePerformIO $! IO $ \s0 ->
case unsafeThawSmallArray# arr0 s0 of
(# s1, arr1 #) ->
case readSmallArray# arr1 index s1 of
(# s2, a #) -> (# s2, unsafeCoerce# a #)
set :: forall a. Int -> a -> UntypedArray -> UntypedArray
set (I# index) a (UntypedArray size arr0) =
unsafePerformIO $! IO $ \s0 ->
case newSmallArray# size (error "set") s0 of
(# s1, arr1 #) ->
case copySmallArray# arr0 0# arr1 0# size s1 of
s2 ->
case writeSmallArray# arr1 index (unsafeCoerce# a) s2 of
s3 ->
case unsafeFreezeSmallArray# arr1 s3 of
(# s4, arr2 #) -> (# s4, UntypedArray size arr2 #)
expect :: Bool -> IO ()
expect cond = void (evaluate (assert cond ()))
main :: IO ()
main = do
let xs = empty |> id @Int 1 |> True |> "hello!" |> id @Double 3.14
expect $ get @Int 0 xs == 1
expect $ get @Bool 1 xs == True
expect $ get @String 2 xs == "hello!"
expect $ get @Double 3 xs == 3.14
expect $ get @Bool 0 (set 0 False xs) == False
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
You can’t perform that action at this time.