diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,12 @@ +PLACEHOLDER +----- + +0.2.0.0 +----- +* Support for `template-haskell-2.8.0.0`. +* Drop support for Control.Concurrent.SampleVar, which is first removed in + `base-4.7.0.0`. This entails a major API change, so one of the first two + components is incremented. +* Replace `syntax-trees` dependency with fork called + `syntax-trees-fork-bairyn` that is able to be built. +* Added `CHANGELOG.md`. diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,28 @@ +Copyright (c) 2011, Byron James Johnson +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + +1. Redistributions of source code must retain the above copyright notice, + this list of conditions and the following disclaimer. + +2. Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + +3. Neither the name of the author nor the names of its contributors may be + used to endorse or promote products derived from this software without + specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE +LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +POSSIBILITY OF SUCH DAMAGE. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,19 @@ +The changelog does not cover every commit. It outlines highlights and +significant changes. + +Quality note: In late 2014, I found this repository on my hard drive from 2011. +I'm surprised and don't remember why I never uploaded this to Hackage. As a +relatively inexperienced 16-year-old with at most 2 years of functional +programming experience (with much more procedural programming experience), I +wrote Haskell code in a way that I now expect to be capable of rewriting with +something of much better quality. But I was pleasantly surprised with the +quality of the documentation, taking into account my memory of my past self. +Quality-wise, it seems better than a few other projects I wrote at around the +same time, e.g. `monad-state`, although that was 6-12 months earlier. + +I've since converted the repository to git and uploaded it to github. I've +patched it up so that it builds, but nothing more yet (sans a few minor +cleanups here and there, largely just in the cabal file, that I'm applying to +each of my old projects I found). + +Contributions, feedback, and constructive criticism are welcome. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/global.cabal b/global.cabal new file mode 100644 --- /dev/null +++ b/global.cabal @@ -0,0 +1,76 @@ +name: global +-- Don't forget to bump the tag and CHANGELOG placeholder too. +version: 0.2.0.0 +cabal-version: >= 1.18 +build-type: Simple +license: BSD3 +license-file: LICENSE +copyright: Copyright (C) 2011 Byron James Johnson +author: Byron James Johnson +maintainer: ByronJohnsonFP@gmail.com +category: Data, Language, System +tested-with: GHC == 7.8.3 +extra-source-files: +-- The extra-doc-files property requires cabal-version >= 1.18. +extra-doc-files: + README.md + ,CHANGELOG.md +synopsis: Haskell2010 compatible library enabling unique top-level declarations +description: + The "global" library enables the declaration of unique top-level + declarations, including references to mutable state accessible via IO. + . + Conceptually, this library defines primitive means of unique declarations, + whose internal implementation is hidden from users, and uses Template + Haskell to provide a public interface. Thus, it is not necessarily + portable across various implementations. It is currently designed to be + compatible with GHC. Users do not need to be aware of the internal, + low-level implementation; if a more portable, stable means of providing the + same functionality becomes available, the library can be updated without + changing the provided public interface. + . + While this library provides the basis for an alternative approach to + managing state, users should consider using instead the @transformers@ + library's StateT transformer, possibly accompanied with @fclabels@ to + manage hierarchical state (libraries that provide a higher-level means of + managing monad stacks based on transformers include @mtl@, @monads-tf@, and + @monad-operations@). This library might be more appropriately used for + other purposes, such as to provide a means to directly translate C to + Haskell with a result whose style more closely resembles that of the + original code. Users should also consider using the language feature + @ImplicitParams@. + . + Examples of small programs that use this library are provided in the + repository in which it resides. + +library + default-language: Haskell2010 + hs-source-dirs: src + ghc-options: -Wall + build-depends: + base >= 4 && < 5 + ,template-haskell >= 2.8.0.0 && < 3 + ,stm >= 2 && < 3 + ,tagged >= 0 && < 1 + ,loch-th >= 0.1 && < 1 + ,haskell-src-exts-qq >= 0.3 && < 1 + ,syntax-trees-fork-bairyn >= 0.1.2.1 && < 1 + ,haskell-src-exts >= 1.9 && < 2 + ,SafeSemaphore >= 0.7 && < 1 + exposed-modules: + Data.Global + default-extensions: + --,GADTs + TemplateHaskell + --,DeriveDataTypeable + other-extensions: + FlexibleInstances + +source-repository head + type: git + location: git@github.com:bairyn/global.git + +source-repository this + type: git + location: git@github.com:bairyn/global.git + tag: v0.2.0.0 diff --git a/src/Data/Global.hs b/src/Data/Global.hs new file mode 100644 --- /dev/null +++ b/src/Data/Global.hs @@ -0,0 +1,812 @@ +{-# LANGUAGE TemplateHaskell, FlexibleInstances #-} + +-- TODO: The DRY principle is violated in the instance declarations of +-- 'UniqueDeclaration'. Fix by writing an abstraction. +-- +-- TODO: The readability of the TH code here would be enhanced by writing in a +-- comment something similar to an example of the output of Template Haskell. +-- Add this. +-- +-- TODO: The understandability of this library could be improved by writing +-- something similar to an example of the output of Template Haskell in the +-- 8documentation8. Add this. (SEE NEXT TODO before removing this TODO.) +-- +-- TODO: ^^ Replacing the @8@s with @*@ (asterisks) in the above TODO breaks +-- haddock -_-. It fails with this: +-- +-- @ +-- % cabal haddock +-- Running Haddock for global-0.1.0.1... +-- Preprocessing library global-0.1.0.1... +-- Haddock coverage: +-- +-- src/Data/Global.hs:13:1: parse error on input ‘module’ +-- @ +-- +-- At *least* file a bug report, please. +module Data.Global + ( UniqueDeclaration(..) + , UDEmpty(..) + , UN + , un + , UT + , ut + , Cnt + , UV + , monomorphic + , QSemQuantity + , translateExtsToTH' + , utl + , ud + , uninitialized + ) where + +import Control.Applicative +import Control.Concurrent.Chan +import Control.Concurrent.FairRWLock as FairRWLock +import Control.Concurrent.MSampleVar as MSampleVar +import Control.Concurrent.MSem as MSem +import Control.Concurrent.MSemN as MSemN +import Control.Concurrent.MVar +import Control.Concurrent.QSem +import Control.Concurrent.QSemN +import Control.Concurrent.STM.TVar +import Control.Concurrent.STM.TMVar +import Control.Concurrent.STM.TChan +import Data.IORef +import Data.Tagged +import Debug.Trace.LocationTH +import qualified Language.Haskell.Exts.Syntax as Exts (Exp) +import Language.Haskell.Exts.QQ +import Fork.Bairyn.Language.Haskell.SyntaxTrees.ExtsToTH +import Language.Haskell.TH +import Language.Haskell.TH.Quote +import System.IO.Unsafe (unsafePerformIO) +import Text.Printf + +-- | Types that can be uniquely declared on the top level. +-- +-- Like 'Monad', this type class itself is not "magical". Its instances, +-- however, may be primitive, at least conceptually, much like 'IO's 'Monad' +-- instance. +-- +-- Individual instances may be accompanied with certain caveats. Each +-- individual instance should include in its documentation what these are. +-- These caveats may affect surrounding code, perhaps in ways detrimental to +-- the program's performance or efficiency; users should thus consider +-- isolating "global" declarations in their own @.Global@ module; this is not +-- necessarily necessary for every instance. See the documentation of the +-- particular instance to see how the declarations should be declared. +-- +-- The type should be monomorphic, or concrete +-- enough, to be type safe, so that the references +-- cannot be treated as multiple concreet types +-- (writing @[Integer]@ to a reference that has the +-- type @IORef [a]@ and subsequently reading @[Char]@ +-- can cause the program to core dump). Ensuring +-- this safety is the responsibility of the +-- implementer of the instances of this type class; +-- other users of this library who do not extend this +-- class's functionality generally do not need to be +-- concerned whether the program will run correctly +-- at run-time, since the mistakes, which can violate +-- type safety, will be caught at compile-time and +-- the code will not build (this is, however, not +-- intrinsically guaranteed, much like the monad +-- laws: they are expected to be followed). It is +-- worth reiterating that instances of this class +-- need to be sure to not allow code with such +-- erroneous types to compile. For more information +-- about type safety, see the documentation of +-- 'unsafePerformIO'. +-- +-- Example: +-- +-- @ +-- un \"lives\" =:: ([| 3 |], ut [t| Integer |] :: UT TVar) +-- @ +-- +-- @lives@ would then refer to the 'TVar' and would initially contain the value @3@. +class UniqueDeclaration u where + -- | Declare uniquely. + (=::) :: + UN u -- ^ Name of reference + -> (UV, UT u) -- ^ Initial value, accompanied with the internal type + -- and tagged with the unique constructor so that the + -- correct instance can be unambiguously determined. + -- + -- An initial value may not make sense in some + -- contexts; implementations of instances may choose + -- to ignore this value, as well as the internal type + -- and unique constructor. Implementations should + -- document how this parameter is used. + -> Q [Dec] -- ^ Top-level declarations for the unique declaration. + -- + -- At least a definition for the name and a type signature should be provided. + +-- | Declaring unique 'IORef's; for thread-safe handling of mutable data, see 'TVar'. +-- +-- The initial value is used so that the reference refers initially to that value. +-- +-- These preconditions apply to GHC 7.0.4 and base-0.4.3.1 and likely similar versions and implementations as well. +-- +-- In its low-level implementation, this instance uses 'unsafePerformIO'; +-- thus, the same preconditions apply to this instance, particularly those +-- regarding top-level declarations (referential transparency cannot be +-- violated here). As of base-4.3.1.0, these conditions, that the user needs +-- to be aware of, are the following: +-- * Compile the declarations with the compiler flag -fno-cse. This +-- prevents multiple references from being substituted to refer to the +-- same data. This flag thus does not affect the semantics of the +-- program, but may potentially adversely affect its performance; thus, +-- isolating in a @.Global@ module may be advisable in some cases. This +-- condition is not strictly necessary when only one declaration is made +-- in a module, since the compiler cannot substitute multiple references +-- to refer to same data. +-- +-- If your code behaves differently when optimizations are enabled, +-- ensure that this flag is indeed being used when the declarations are being compiled. +-- Setting or passing this flag is NOT handled automatically by this +-- implementation; it is the responsibility of users of this +-- implementation to ensure that such appropriate behaviour is set when +-- necessary. +-- +-- This can be accomplished by placing the line @{-# OPTIONS_GHC -fno-cse #-}@ in +-- the file in which the declarations are declared, before the "module" +-- line. +instance UniqueDeclaration IORef where + (Tagged name) =:: (uvq, Tagged typq) = do + uv <- uvq + typ <- typq + $(assert [| monomorphic typ |]) . return $ + [ SigD name $ AppT (ConT ''IORef) typ + , PragmaD (InlineP name NoInline FunLike AllPhases) + , ValD (VarP name) (NormalB $ AppE (VarE 'unsafeUDeclInternal) $ AppE (VarE 'newIORef) uv) [] + ] + +-- | Declaring unique 'MVar's; see also 'TMVar'; caveats are the same as those of 'IORef's. +-- +-- The initial value is used so that the reference refers initially to that value. +-- +-- These preconditions apply to GHC 7.0.4 and base-0.4.3.1 and likely similar versions and implementations as well. +-- +-- In its low-level implementation, this instance uses 'unsafePerformIO'; +-- thus, the same caveats apply to this instance, particularly those +-- regarding top-level declarations (referential transparency cannot be +-- violated here). As of base-4.3.1.0, these conditions, that the user needs +-- to be aware of, are the following: +-- * Compile the declarations with the compiler flag -fno-cse. This +-- prevents multiple references from being substituted to refer to the +-- same data. This flag thus does not affect the semantics of the +-- program, but may potentially adversely affect its performance; thus, +-- isolating in a @.Global@ module may be advisable in some cases. This +-- condition is not strictly necessary when only one declaration is made +-- in a module, since the compiler cannot substitute multiple references +-- to refer to same data. +-- +-- If your code behaves differently when optimizations are enabled, +-- ensure that this flag is indeed being used when the declarations are being compiled. +-- Setting or passing this flag is NOT handled automatically by this +-- implementation; it is the responsibility of users of this +-- implementation to ensure that such appropriate behaviour is set when +-- necessary. +-- +-- This can be accomplished by placing the line @{-# OPTIONS_GHC -fno-cse #-}@ in +-- the file in which the declarations are declared, before the "module" +-- line. +instance UniqueDeclaration MVar where + (Tagged name) =:: (uvq, Tagged typq) = do + uv <- uvq + typ <- typq + $(assert [| monomorphic typ |]) . return $ + [ SigD name $ AppT (ConT ''MVar) typ + , PragmaD (InlineP name NoInline FunLike AllPhases) + , ValD (VarP name) (NormalB $ AppE (VarE 'unsafeUDeclInternal) $ AppE (VarE 'newMVar) uv) [] + ] + +-- | Declaring unique 'MVar's that are initially empty; see also 'TMVar'. +-- +-- The initial value is ignored. +-- +-- These preconditions apply to GHC 7.0.4 and base-0.4.3.1 and likely similar versions and implementations as well. +-- +-- In its low-level implementation, this instance uses 'unsafePerformIO'; +-- thus, the same caveats apply to this instance, particularly those +-- regarding top-level declarations (referential transparency cannot be +-- violated here). As of base-4.3.1.0, these conditions, that the user needs +-- to be aware of, are the following: +-- * Compile the declarations with the compiler flag -fno-cse. This +-- prevents multiple references from being substituted to refer to the +-- same data. This flag thus does not affect the semantics of the +-- program, but may potentially adversely affect its performance; thus, +-- isolating in a @.Global@ module may be advisable in some cases. This +-- condition is not strictly necessary when only one declaration is made +-- in a module, since the compiler cannot substitute multiple references +-- to refer to same data. +-- +-- If your code behaves differently when optimizations are enabled, +-- ensure that this flag is indeed being used when the declarations are being compiled. +-- Setting or passing this flag is NOT handled automatically by this +-- implementation; it is the responsibility of users of this +-- implementation to ensure that such appropriate behaviour is set when +-- necessary. +-- +-- This can be accomplished by placing the line @{-# OPTIONS_GHC -fno-cse #-}@ in +-- the file in which the declarations are declared, before the "module" +-- line. +instance UniqueDeclaration (UDEmpty MVar) where + (Tagged name) =:: (_, Tagged typq) = do + typ <- typq + $(assert [| monomorphic typ |]) . return $ + [ SigD name $ AppT (ConT ''MVar) typ + , PragmaD (InlineP name NoInline FunLike AllPhases) + , ValD (VarP name) (NormalB $ AppE (VarE 'unsafeUDeclInternal) $ VarE 'newEmptyMVar) [] + ] + +-- | Declaring unique 'Chan's that are initially empty; for thread-safe atomic accessing of channels, see 'TChan'; caveats are the same as those of 'MVar's that are initially empty. +-- +-- The initial value is ignored. +-- +-- These preconditions apply to GHC 7.0.4 and base-0.4.3.1 and likely similar versions and implementations as well. +-- +-- In its low-level implementation, this instance uses 'unsafePerformIO'; +-- thus, the same caveats apply to this instance, particularly those +-- regarding top-level declarations (referential transparency cannot be +-- violated here). As of base-4.3.1.0, these conditions, that the user needs +-- to be aware of, are the following: +-- * Compile the declarations with the compiler flag -fno-cse. This +-- prevents multiple references from being substituted to refer to the +-- same data. This flag thus does not affect the semantics of the +-- program, but may potentially adversely affect its performance; thus, +-- isolating in a @.Global@ module may be advisable in some cases. This +-- condition is not strictly necessary when only one declaration is made +-- in a module, since the compiler cannot substitute multiple references +-- to refer to same data. +-- +-- If your code behaves differently when optimizations are enabled, +-- ensure that this flag is indeed being used when the declarations are being compiled. +-- Setting or passing this flag is NOT handled automatically by this +-- implementation; it is the responsibility of users of this +-- implementation to ensure that such appropriate behaviour is set when +-- necessary. +-- +-- This can be accomplished by placing the line @{-# OPTIONS_GHC -fno-cse #-}@ in +-- the file in which the declarations are declared, before the "module" +-- line. +instance UniqueDeclaration (UDEmpty Chan) where + (Tagged name) =:: (_, Tagged typq) = do + typ <- typq + $(assert [| monomorphic typ |]) . return $ + [ SigD name $ AppT (ConT ''Chan) typ + , PragmaD (InlineP name NoInline FunLike AllPhases) + , ValD (VarP name) (NormalB $ AppE (VarE 'unsafeUDeclInternal) $ VarE 'newChan) [] + ] + +-- | Declaring unique 'QSem's. +-- +-- The initial value; which is, in this case, determines the initial quantity +-- of the semaphore; is passed to 'newQSem'; the types thus must match. The +-- internal type is ignored. +-- +-- NB: When multiple units of a resource are needed simultaneously, consider using 'QSemN's to avoid deadlocks. +-- +-- These preconditions apply to GHC 7.0.4 and base-0.4.3.1 and likely similar versions and implementations as well. +-- +-- In its low-level implementation, this instance uses 'unsafePerformIO'; +-- thus, the same caveats apply to this instance, particularly those +-- regarding top-level declarations (referential transparency cannot be +-- violated here). As of base-4.3.1.0, these conditions, that the user needs +-- to be aware of, are the following: +-- * Compile the declarations with the compiler flag -fno-cse. This +-- prevents multiple references from being substituted to refer to the +-- same data. This flag thus does not affect the semantics of the +-- program, but may potentially adversely affect its performance; thus, +-- isolating in a @.Global@ module may be advisable in some cases. This +-- condition is not strictly necessary when only one declaration is made +-- in a module, since the compiler cannot substitute multiple references +-- to refer to same data. +-- +-- If your code behaves differently when optimizations are enabled, +-- ensure that this flag is indeed being used when the declarations are being compiled. +-- Setting or passing this flag is NOT handled automatically by this +-- implementation; it is the responsibility of users of this +-- implementation to ensure that such appropriate behaviour is set when +-- necessary. +-- +-- This can be accomplished by placing the line @{-# OPTIONS_GHC -fno-cse #-}@ in +-- the file in which the declarations are declared, before the "module" +-- line. +instance UniqueDeclaration (Const QSem) where + (Tagged name) =:: (uvq, _) = do + uv <- uvq + return $ + [ SigD name $ ConT ''QSem + , PragmaD (InlineP name NoInline FunLike AllPhases) + , ValD (VarP name) (NormalB $ AppE (VarE 'unsafeUDeclInternal) $ AppE (VarE 'newQSem) uv) [] + ] + +-- | Declaring unique 'QSemN's. +-- +-- The initial value; which is, in this case, determines the initial quantity +-- of the semaphore; is passed to 'newQSemN'; the types thus must match. The +-- internal type is ignored. +-- +-- NB: When multiple units of a resource are needed simultaneously, consider using 'QSemN's to avoid deadlocks. +-- +-- These preconditions apply to GHC 7.0.4 and base-0.4.3.1 and likely similar versions and implementations as well. +-- +-- In its low-level implementation, this instance uses 'unsafePerformIO'; +-- thus, the same caveats apply to this instance, particularly those +-- regarding top-level declarations (referential transparency cannot be +-- violated here). As of base-4.3.1.0, these conditions, that the user needs +-- to be aware of, are the following: +-- * Compile the declarations with the compiler flag -fno-cse. This +-- prevents multiple references from being substituted to refer to the +-- same data. This flag thus does not affect the semantics of the +-- program, but may potentially adversely affect its performance; thus, +-- isolating in a @.Global@ module may be advisable in some cases. This +-- condition is not strictly necessary when only one declaration is made +-- in a module, since the compiler cannot substitute multiple references +-- to refer to same data. +-- +-- If your code behaves differently when optimizations are enabled, +-- ensure that this flag is indeed being used when the declarations are being compiled. +-- Setting or passing this flag is NOT handled automatically by this +-- implementation; it is the responsibility of users of this +-- implementation to ensure that such appropriate behaviour is set when +-- necessary. +-- +-- This can be accomplished by placing the line @{-# OPTIONS_GHC -fno-cse #-}@ in +-- the file in which the declarations are declared, before the "module" +-- line. +instance UniqueDeclaration (Const QSemN) where + (Tagged name) =:: (uvq, _) = do + uv <- uvq + return $ + [ SigD name $ ConT ''QSemN + , PragmaD (InlineP name NoInline FunLike AllPhases) + , ValD (VarP name) (NormalB $ AppE (VarE 'unsafeUDeclInternal) $ AppE (VarE 'newQSemN) uv) [] + ] + +-- | Declaring unique 'RWLock's. +-- +-- The initial value and the internal type are ignored. +-- +-- NB: When multiple units of a resource are needed simultaneously, consider using 'QSemN's to avoid deadlocks. +-- +-- These preconditions apply to GHC 7.0.4 and base-0.4.3.1 and likely similar versions and implementations as well. +-- +-- In its low-level implementation, this instance uses 'unsafePerformIO'; +-- thus, the same caveats apply to this instance, particularly those +-- regarding top-level declarations (referential transparency cannot be +-- violated here). As of base-4.3.1.0, these conditions, that the user needs +-- to be aware of, are the following: +-- * Compile the declarations with the compiler flag -fno-cse. This +-- prevents multiple references from being substituted to refer to the +-- same data. This flag thus does not affect the semantics of the +-- program, but may potentially adversely affect its performance; thus, +-- isolating in a @.Global@ module may be advisable in some cases. This +-- condition is not strictly necessary when only one declaration is made +-- in a module, since the compiler cannot substitute multiple references +-- to refer to same data. +-- +-- If your code behaves differently when optimizations are enabled, +-- ensure that this flag is indeed being used when the declarations are being compiled. +-- Setting or passing this flag is NOT handled automatically by this +-- implementation; it is the responsibility of users of this +-- implementation to ensure that such appropriate behaviour is set when +-- necessary. +-- +-- This can be accomplished by placing the line @{-# OPTIONS_GHC -fno-cse #-}@ in +-- the file in which the declarations are declared, before the "module" +-- line. +instance UniqueDeclaration (Const RWLock) where + (Tagged name) =:: (_, _) = do + return $ + [ SigD name $ ConT ''RWLock + , PragmaD (InlineP name NoInline FunLike AllPhases) + , ValD (VarP name) (NormalB $ AppE (VarE 'unsafeUDeclInternal) $ VarE 'FairRWLock.new) [] + ] + +-- | Declaring unique 'MSampleVar's; caveats are the same as those of 'IORef's. +-- +-- The initial value is used so that the reference refers initially to that value. +-- +-- These preconditions apply to GHC 7.0.4 and base-0.4.3.1 and likely similar versions and implementations as well. +-- +-- In its low-level implementation, this instance uses 'unsafePerformIO'; +-- thus, the same caveats apply to this instance, particularly those +-- regarding top-level declarations (referential transparency cannot be +-- violated here). As of base-4.3.1.0, these conditions, that the user needs +-- to be aware of, are the following: +-- * Compile the declarations with the compiler flag -fno-cse. This +-- prevents multiple references from being substituted to refer to the +-- same data. This flag thus does not affect the semantics of the +-- program, but may potentially adversely affect its performance; thus, +-- isolating in a @.Global@ module may be advisable in some cases. This +-- condition is not strictly necessary when only one declaration is made +-- in a module, since the compiler cannot substitute multiple references +-- to refer to same data. +-- +-- If your code behaves differently when optimizations are enabled, +-- ensure that this flag is indeed being used when the declarations are being compiled. +-- Setting or passing this flag is NOT handled automatically by this +-- implementation; it is the responsibility of users of this +-- implementation to ensure that such appropriate behaviour is set when +-- necessary. +-- +-- This can be accomplished by placing the line @{-# OPTIONS_GHC -fno-cse #-}@ in +-- the file in which the declarations are declared, before the "module" +-- line. +instance UniqueDeclaration MSampleVar where + (Tagged name) =:: (uvq, Tagged typq) = do + uv <- uvq + typ <- typq + $(assert [| monomorphic typ |]) . return $ + [ SigD name $ AppT (ConT ''MSampleVar) typ + , PragmaD (InlineP name NoInline FunLike AllPhases) + , ValD (VarP name) (NormalB $ AppE (VarE 'unsafeUDeclInternal) $ AppE (VarE 'MSampleVar.newSV) uv) [] + ] + +-- | Declaring unique 'MSampleVars's that are initially empty; caveats are the same as those of 'MVar's that are initially empty. +-- +-- The initial value is ignored. +-- +-- These preconditions apply to GHC 7.0.4 and base-0.4.3.1 and likely similar versions and implementations as well. +-- +-- In its low-level implementation, this instance uses 'unsafePerformIO'; +-- thus, the same caveats apply to this instance, particularly those +-- regarding top-level declarations (referential transparency cannot be +-- violated here). As of base-4.3.1.0, these conditions, that the user needs +-- to be aware of, are the following: +-- * Compile the declarations with the compiler flag -fno-cse. This +-- prevents multiple references from being substituted to refer to the +-- same data. This flag thus does not affect the semantics of the +-- program, but may potentially adversely affect its performance; thus, +-- isolating in a @.Global@ module may be advisable in some cases. This +-- condition is not strictly necessary when only one declaration is made +-- in a module, since the compiler cannot substitute multiple references +-- to refer to same data. +-- +-- If your code behaves differently when optimizations are enabled, +-- ensure that this flag is indeed being used when the declarations are being compiled. +-- Setting or passing this flag is NOT handled automatically by this +-- implementation; it is the responsibility of users of this +-- implementation to ensure that such appropriate behaviour is set when +-- necessary. +-- +-- This can be accomplished by placing the line @{-# OPTIONS_GHC -fno-cse #-}@ in +-- the file in which the declarations are declared, before the "module" +-- line. +instance UniqueDeclaration (UDEmpty MSampleVar) where + (Tagged name) =:: (_, Tagged typq) = do + typ <- typq + $(assert [| monomorphic typ |]) . return $ + [ SigD name $ AppT (ConT ''MSampleVar) typ + , PragmaD (InlineP name NoInline FunLike AllPhases) + , ValD (VarP name) (NormalB $ AppE (VarE 'unsafeUDeclInternal) $ VarE 'MSampleVar.newEmptySV) [] + ] + +-- | Declaring unique 'MSem's. +-- +-- The initial value; which is, in this case, determines the initial quantity +-- of the semaphore; is passed to 'newMSem'; the types thus must match. The +-- internal type is given to the 'MSem' constructor to construct a semaphore +-- based on an integral type. +-- +-- NB: When multiple units of a resource are needed simultaneously, consider using 'MSemN's to avoid deadlocks. +-- +-- These preconditions apply to GHC 7.0.4 and base-0.4.3.1 and likely similar versions and implementations as well. +-- +-- In its low-level implementation, this instance uses 'unsafePerformIO'; +-- thus, the same caveats apply to this instance, particularly those +-- regarding top-level declarations (referential transparency cannot be +-- violated here). As of base-4.3.1.0, these conditions, that the user needs +-- to be aware of, are the following: +-- * Compile the declarations with the compiler flag -fno-cse. This +-- prevents multiple references from being substituted to refer to the +-- same data. This flag thus does not affect the semantics of the +-- program, but may potentially adversely affect its performance; thus, +-- isolating in a @.Global@ module may be advisable in some cases. This +-- condition is not strictly necessary when only one declaration is made +-- in a module, since the compiler cannot substitute multiple references +-- to refer to same data. +-- +-- If your code behaves differently when optimizations are enabled, +-- ensure that this flag is indeed being used when the declarations are being compiled. +-- Setting or passing this flag is NOT handled automatically by this +-- implementation; it is the responsibility of users of this +-- implementation to ensure that such appropriate behaviour is set when +-- necessary. +-- +-- This can be accomplished by placing the line @{-# OPTIONS_GHC -fno-cse #-}@ in +-- the file in which the declarations are declared, before the "module" +-- line. +instance UniqueDeclaration MSem where + (Tagged name) =:: (uvq, Tagged typq) = do + uv <- uvq + typ <- typq + return $ + [ SigD name $ AppT (ConT ''MSem) typ + , PragmaD (InlineP name NoInline FunLike AllPhases) + , ValD (VarP name) (NormalB $ AppE (VarE 'unsafeUDeclInternal) $ AppE (VarE 'MSem.new) uv) [] + ] + +-- | Declaring unique 'MSemN's. +-- +-- The initial value; which is, in this case, determines the initial quantity +-- of the semaphore; is passed to 'newMSemN'; the types thus must match. The +-- internal type is given to the 'MSemN' constructor to construct a semaphore +-- based on an integral type. +-- +-- NB: When multiple units of a resource are needed simultaneously, consider using 'MSemN's to avoid deadlocks. +-- +-- These preconditions apply to GHC 7.0.4 and base-0.4.3.1 and likely similar versions and implementations as well. +-- +-- In its low-level implementation, this instance uses 'unsafePerformIO'; +-- thus, the same caveats apply to this instance, particularly those +-- regarding top-level declarations (referential transparency cannot be +-- violated here). As of base-4.3.1.0, these conditions, that the user needs +-- to be aware of, are the following: +-- * Compile the declarations with the compiler flag -fno-cse. This +-- prevents multiple references from being substituted to refer to the +-- same data. This flag thus does not affect the semantics of the +-- program, but may potentially adversely affect its performance; thus, +-- isolating in a @.Global@ module may be advisable in some cases. This +-- condition is not strictly necessary when only one declaration is made +-- in a module, since the compiler cannot substitute multiple references +-- to refer to same data. +-- +-- If your code behaves differently when optimizations are enabled, +-- ensure that this flag is indeed being used when the declarations are being compiled. +-- Setting or passing this flag is NOT handled automatically by this +-- implementation; it is the responsibility of users of this +-- implementation to ensure that such appropriate behaviour is set when +-- necessary. +-- +-- This can be accomplished by placing the line @{-# OPTIONS_GHC -fno-cse #-}@ in +-- the file in which the declarations are declared, before the "module" +-- line. +instance UniqueDeclaration MSemN where + (Tagged name) =:: (uvq, Tagged typq) = do + uv <- uvq + typ <- typq + return $ + [ SigD name $ AppT (ConT ''MSemN) typ + , PragmaD (InlineP name NoInline FunLike AllPhases) + , ValD (VarP name) (NormalB $ AppE (VarE 'unsafeUDeclInternal) $ AppE (VarE 'MSemN.new) uv) [] + ] + +-- | Declaring unique 'TVar's; caveats are the same as those of 'IORef's. +-- +-- The initial value is used so that the reference refers initially to that value. +-- +-- These preconditions apply to GHC 7.0.4 and base-0.4.3.1 and likely similar versions and implementations as well. +-- +-- In its low-level implementation, this instance uses 'unsafePerformIO'; +-- thus, the same caveats apply to this instance, particularly those +-- regarding top-level declarations (referential transparency cannot be +-- violated here). As of base-4.3.1.0, these conditions, that the user needs +-- to be aware of, are the following: +-- * Compile the declarations with the compiler flag -fno-cse. This +-- prevents multiple references from being substituted to refer to the +-- same data. This flag thus does not affect the semantics of the +-- program, but may potentially adversely affect its performance; thus, +-- isolating in a @.Global@ module may be advisable in some cases. This +-- condition is not strictly necessary when only one declaration is made +-- in a module, since the compiler cannot substitute multiple references +-- to refer to same data. +-- +-- If your code behaves differently when optimizations are enabled, +-- ensure that this flag is indeed being used when the declarations are being compiled. +-- Setting or passing this flag is NOT handled automatically by this +-- implementation; it is the responsibility of users of this +-- implementation to ensure that such appropriate behaviour is set when +-- necessary. +-- +-- This can be accomplished by placing the line @{-# OPTIONS_GHC -fno-cse #-}@ in +-- the file in which the declarations are declared, before the "module" +-- line. +instance UniqueDeclaration TVar where + (Tagged name) =:: (uvq, Tagged typq) = do + uv <- uvq + typ <- typq + $(assert [| monomorphic typ |]) . return $ + [ SigD name $ AppT (ConT ''TVar) typ + , PragmaD (InlineP name NoInline FunLike AllPhases) + , ValD (VarP name) (NormalB $ AppE (VarE 'unsafeUDeclInternal) $ AppE (VarE 'newTVarIO) uv) [] + ] + +-- | Declaring unique 'TMVar's; caveats are the same as those of 'IORef's. +-- +-- The initial value is used so that the reference refers initially to that value. +-- +-- These preconditions apply to GHC 7.0.4 and base-0.4.3.1 and likely similar versions and implementations as well. +-- +-- In its low-level implementation, this instance uses 'unsafePerformIO'; +-- thus, the same caveats apply to this instance, particularly those +-- regarding top-level declarations (referential transparency cannot be +-- violated here). As of base-4.3.1.0, these conditions, that the user needs +-- to be aware of, are the following: +-- * Compile the declarations with the compiler flag -fno-cse. This +-- prevents multiple references from being substituted to refer to the +-- same data. This flag thus does not affect the semantics of the +-- program, but may potentially adversely affect its performance; thus, +-- isolating in a @.Global@ module may be advisable in some cases. This +-- condition is not strictly necessary when only one declaration is made +-- in a module, since the compiler cannot substitute multiple references +-- to refer to same data. +-- +-- If your code behaves differently when optimizations are enabled, +-- ensure that this flag is indeed being used when the declarations are being compiled. +-- Setting or passing this flag is NOT handled automatically by this +-- implementation; it is the responsibility of users of this +-- implementation to ensure that such appropriate behaviour is set when +-- necessary. +-- +-- This can be accomplished by placing the line @{-# OPTIONS_GHC -fno-cse #-}@ in +-- the file in which the declarations are declared, before the "module" +-- line. +instance UniqueDeclaration TMVar where + (Tagged name) =:: (uvq, Tagged typq) = do + uv <- uvq + typ <- typq + $(assert [| monomorphic typ |]) . return $ + [ SigD name $ AppT (ConT ''TMVar) typ + , PragmaD (InlineP name NoInline FunLike AllPhases) + , ValD (VarP name) (NormalB $ AppE (VarE 'unsafeUDeclInternal) $ AppE (VarE 'newTMVarIO) uv) [] + ] + +-- | Declaring unique 'TMVar's that are initially empty; caveats are the same as those of 'MVar's that are initially empty. +-- +-- The initial value is ignored. +-- +-- These preconditions apply to GHC 7.0.4 and base-0.4.3.1 and likely similar versions and implementations as well. +-- +-- In its low-level implementation, this instance uses 'unsafePerformIO'; +-- thus, the same caveats apply to this instance, particularly those +-- regarding top-level declarations (referential transparency cannot be +-- violated here). As of base-4.3.1.0, these conditions, that the user needs +-- to be aware of, are the following: +-- * Compile the declarations with the compiler flag -fno-cse. This +-- prevents multiple references from being substituted to refer to the +-- same data. This flag thus does not affect the semantics of the +-- program, but may potentially adversely affect its performance; thus, +-- isolating in a @.Global@ module may be advisable in some cases. This +-- condition is not strictly necessary when only one declaration is made +-- in a module, since the compiler cannot substitute multiple references +-- to refer to same data. +-- +-- If your code behaves differently when optimizations are enabled, +-- ensure that this flag is indeed being used when the declarations are being compiled. +-- Setting or passing this flag is NOT handled automatically by this +-- implementation; it is the responsibility of users of this +-- implementation to ensure that such appropriate behaviour is set when +-- necessary. +-- +-- This can be accomplished by placing the line @{-# OPTIONS_GHC -fno-cse #-}@ in +-- the file in which the declarations are declared, before the "module" +-- line. +instance UniqueDeclaration (UDEmpty TMVar) where + (Tagged name) =:: (_, Tagged typq) = do + typ <- typq + $(assert [| monomorphic typ |]) . return $ + [ SigD name $ AppT (ConT ''TMVar) typ + , PragmaD (InlineP name NoInline FunLike AllPhases) + , ValD (VarP name) (NormalB $ AppE (VarE 'unsafeUDeclInternal) $ VarE 'newEmptyTMVarIO) [] + ] + +-- | Declaring unique 'TChan's that are initially empty; caveats are the same as those of 'MVar's that are initially empty. +-- +-- The initial value is ignored. +-- +-- These preconditions apply to GHC 7.0.4 and base-0.4.3.1 and likely similar versions and implementations as well. +-- +-- In its low-level implementation, this instance uses 'unsafePerformIO'; +-- thus, the same caveats apply to this instance, particularly those +-- regarding top-level declarations (referential transparency cannot be +-- violated here). As of base-4.3.1.0, these conditions, that the user needs +-- to be aware of, are the following: +-- * Compile the declarations with the compiler flag -fno-cse. This +-- prevents multiple references from being substituted to refer to the +-- same data. This flag thus does not affect the semantics of the +-- program, but may potentially adversely affect its performance; thus, +-- isolating in a @.Global@ module may be advisable in some cases. This +-- condition is not strictly necessary when only one declaration is made +-- in a module, since the compiler cannot substitute multiple references +-- to refer to same data. +-- +-- If your code behaves differently when optimizations are enabled, +-- ensure that this flag is indeed being used when the declarations are being compiled. +-- Setting or passing this flag is NOT handled automatically by this +-- implementation; it is the responsibility of users of this +-- implementation to ensure that such appropriate behaviour is set when +-- necessary. +-- +-- This can be accomplished by placing the line @{-# OPTIONS_GHC -fno-cse #-}@ in +-- the file in which the declarations are declared, before the "module" +-- line. +instance UniqueDeclaration (UDEmpty TChan) where + (Tagged name) =:: (_, Tagged typq) = do + typ <- typq + $(assert [| monomorphic typ |]) . return $ + [ SigD name $ AppT (ConT ''TChan) typ + , PragmaD (InlineP name NoInline FunLike AllPhases) + , ValD (VarP name) (NormalB $ AppE (VarE 'unsafeUDeclInternal) $ VarE 'newTChanIO) [] + ] + +-- | Identity type wrapper that indicates that the unique declaration should be "empty" by default. +newtype UDEmpty u a = UDEmpty (u a) + +-- | Tagged name type. +type UN u = Tagged (Cnt u) Name +-- | Construct a name for a unique declaration from a string. +un :: (UniqueDeclaration u) => String -> UN u +un = Tagged . mkName + +-- | Tagged unique declaration type. +type UT c = Tagged (Cnt c) TypeQ +-- | Tagged unique declaration type constructor. +ut :: (UniqueDeclaration c) => TypeQ -> UT c +ut = Tagged + +-- | Transform a container with kind @* -> *@ into a concrete type @*@ by +-- applying the type '()' to the constructor. +-- +-- Intended to be used for tagging types for unique declarations. +type Cnt c = c () + +-- | An expression for a value contained in a unique declaration. +type UV = ExpQ + +-- | Determine whether a type is polymorphic. +monomorphic :: Type -> Bool +monomorphic (ConT _) = True +monomorphic (TupleT _) = True +monomorphic (ArrowT) = True +monomorphic (ListT) = True +monomorphic (AppT _ _) = True +monomorphic (SigT _ _) = True +monomorphic t = $failure $ printf "type is too polymorphic: `%s'" (pprint t) + +-- | Type of 'unsafeUDeclInternal', used only by this library. +type UnsafeUDeclInternal a = IO a -> a + +-- | The type of values that supply an initial quantity for quantity semaphores. +type QSemQuantity = Int + +-- | Internal means of constructing unique values, used only by this library. +-- +-- 'unsafeUDeclInternal' should never be used directly, outside this +-- library. +unsafeUDeclInternal :: UnsafeUDeclInternal a +{-# NOINLINE unsafeUDeclInternal #-} +unsafeUDeclInternal = unsafePerformIO + +-- | Translate an "Exts" AST to a Template Haskell AST, failing when the translation result is not a Template Haskell AST. +-- +-- This is defined in terms of 'Language.Haskell.Exts.QQ.translateExtsToTH' +translateExtsToTH' :: Exts.Exp -> Exp +translateExtsToTH' = either (const $ $failure $ printf "translating Exts AST to Template Haskell AST resulted in Exts AST") id . translateExtsToTH + +-- | Apply translateExtsToTH' and lift the result into the 'Q' monad. +-- +-- This is often used with 'ud' to refer to variables whose names are not required to be in scope when the quotation is expanded, in a very roundabout way. +-- +-- "utl" can be thought of as a mnemonic for "unique", "translate" and "lift"; and will be updated appropriately to reflect changes to 'UV'. +-- +-- For example, to enable self-referential recursion by referring to +-- variables whose names are not yet in scope, an expression quotation +-- @[| … |]@ can usually be written as @utl [ud| … |]@. +utl :: Exts.Exp -> UV +utl = return . translateExtsToTH' + +-- | Alias to the 'QuasiQuoter' 'hs', which does not require names to be in scope when the quotation is expanded, which enables self-referential recursion. +ud :: QuasiQuoter +ud = hs + +-- | An alternative to providing an initial value. +-- +-- Warning: attempting to read uninitialized references can cause the program to crash. +uninitialized :: Q Exp +uninitialized = [| $failure "uninitialized" |]