From f723b8b878a3c4a4687b9e337a875500bebb39b1 Mon Sep 17 00:00:00 2001 From: Vincent Ambo Date: Thu, 4 Jul 2019 11:18:12 +0100 Subject: feat(third_party/bazel): Check in rules_haskell from Tweag --- .../examples/primitive/Data/Primitive/MutVar.hs | 86 ++++++++++++++++++++++ 1 file changed, 86 insertions(+) create mode 100644 third_party/bazel/rules_haskell/examples/primitive/Data/Primitive/MutVar.hs (limited to 'third_party/bazel/rules_haskell/examples/primitive/Data/Primitive/MutVar.hs') diff --git a/third_party/bazel/rules_haskell/examples/primitive/Data/Primitive/MutVar.hs b/third_party/bazel/rules_haskell/examples/primitive/Data/Primitive/MutVar.hs new file mode 100644 index 000000000000..f707bfb6308c --- /dev/null +++ b/third_party/bazel/rules_haskell/examples/primitive/Data/Primitive/MutVar.hs @@ -0,0 +1,86 @@ +{-# LANGUAGE MagicHash, UnboxedTuples, DeriveDataTypeable #-} + +-- | +-- Module : Data.Primitive.MutVar +-- Copyright : (c) Justin Bonnar 2011, Roman Leshchinskiy 2011-2012 +-- License : BSD-style +-- +-- Maintainer : Roman Leshchinskiy +-- Portability : non-portable +-- +-- Primitive boxed mutable variables +-- + +module Data.Primitive.MutVar ( + MutVar(..), + + newMutVar, + readMutVar, + writeMutVar, + + atomicModifyMutVar, + atomicModifyMutVar', + modifyMutVar, + modifyMutVar' +) where + +import Control.Monad.Primitive ( PrimMonad(..), primitive_ ) +import GHC.Prim ( MutVar#, sameMutVar#, newMutVar#, + readMutVar#, writeMutVar#, atomicModifyMutVar# ) +import Data.Primitive.Internal.Compat ( isTrue# ) +import Data.Typeable ( Typeable ) + +-- | A 'MutVar' behaves like a single-element mutable array associated +-- with a primitive state token. +data MutVar s a = MutVar (MutVar# s a) + deriving ( Typeable ) + +instance Eq (MutVar s a) where + MutVar mva# == MutVar mvb# = isTrue# (sameMutVar# mva# mvb#) + +-- | Create a new 'MutVar' with the specified initial value +newMutVar :: PrimMonad m => a -> m (MutVar (PrimState m) a) +{-# INLINE newMutVar #-} +newMutVar initialValue = primitive $ \s# -> + case newMutVar# initialValue s# of + (# s'#, mv# #) -> (# s'#, MutVar mv# #) + +-- | Read the value of a 'MutVar' +readMutVar :: PrimMonad m => MutVar (PrimState m) a -> m a +{-# INLINE readMutVar #-} +readMutVar (MutVar mv#) = primitive (readMutVar# mv#) + +-- | Write a new value into a 'MutVar' +writeMutVar :: PrimMonad m => MutVar (PrimState m) a -> a -> m () +{-# INLINE writeMutVar #-} +writeMutVar (MutVar mv#) newValue = primitive_ (writeMutVar# mv# newValue) + +-- | Atomically mutate the contents of a 'MutVar' +atomicModifyMutVar :: PrimMonad m => MutVar (PrimState m) a -> (a -> (a,b)) -> m b +{-# INLINE atomicModifyMutVar #-} +atomicModifyMutVar (MutVar mv#) f = primitive $ atomicModifyMutVar# mv# f + +-- | Strict version of 'atomicModifyMutVar'. This forces both the value stored +-- in the 'MutVar' as well as the value returned. +atomicModifyMutVar' :: PrimMonad m => MutVar (PrimState m) a -> (a -> (a, b)) -> m b +{-# INLINE atomicModifyMutVar' #-} +atomicModifyMutVar' mv f = do + b <- atomicModifyMutVar mv force + b `seq` return b + where + force x = let (a, b) = f x in (a, a `seq` b) + +-- | Mutate the contents of a 'MutVar' +modifyMutVar :: PrimMonad m => MutVar (PrimState m) a -> (a -> a) -> m () +{-# INLINE modifyMutVar #-} +modifyMutVar (MutVar mv#) g = primitive_ $ \s# -> + case readMutVar# mv# s# of + (# s'#, a #) -> writeMutVar# mv# (g a) s'# + +-- | Strict version of 'modifyMutVar' +modifyMutVar' :: PrimMonad m => MutVar (PrimState m) a -> (a -> a) -> m () +{-# INLINE modifyMutVar' #-} +modifyMutVar' (MutVar mv#) g = primitive_ $ \s# -> + case readMutVar# mv# s# of + (# s'#, a #) -> let a' = g a in a' `seq` writeMutVar# mv# a' s'# + -- cgit 1.4.1