packages feed

function-combine (empty) → 0.0.1

raw patch · 7 files changed

+268/−0 lines, 7 filesdep +basedep +data-typesetup-changed

Dependencies added: base, data-type

Files

+ .ghci view
@@ -0,0 +1,3 @@+let extensions= (const . return $ let version = Data.Version.versionBranch System.Info.compilerVersion in if version < [6, 6] then ":set -fglasgow-exts -fallow-undecidable-instances -fallow-overlapping-instances" else if version >= [6, 8] then ":set -XTypeOperators" else "") :: String -> IO String
+:def extensions extensions
+:extensions
+ Control/Combine.hs view
@@ -0,0 +1,114 @@+{-# LANGUAGE UndecidableInstances, ScopedTypeVariables, EmptyDataDecls #-}
+{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies #-}
+{-# LANGUAGE FlexibleInstances #-}
+--
+-- .$Header: c:/Source/Haskell/Combine/Control/RCS/Combine.hs,v 1.5 2009/12/09 00:54:03 dosuser Exp dosuser $
+module Control.Combine where
+
+import Data.Type.Apply
+import Data.Type.Eq
+
+data Z = Z
+data S n = S n
+
+zero :: Z
+zero = Z
+one :: S Z
+one = S Z
+two :: S (S Z)
+two = S one
+three :: S (S (S Z))
+three = S two
+
+class Nat n where
+    fromNat :: Enum e => n -> e
+
+instance Nat Z where
+    fromNat _ = toEnum 0
+
+instance forall n. Nat n => Nat (S n) where
+    fromNat _ = succ $ fromNat (undefined :: n)
+
+class ComposeType n a b c | n a b -> c
+
+instance (TypeCast d a, TypeCast e c, TypeCast f b) =>
+    ComposeType Z (b -> c) (a -> f) (d -> e)
+
+instance ComposeType n (b -> c) s t =>
+    ComposeType (S n) (b -> c) (a -> s) (a -> t)
+
+data C f g
+
+instance Apply (C (b -> c) (a -> b)) Z ((b -> c) -> (a -> b) -> (a -> c)) where
+    apply _ _ = (.)
+
+instance forall n a b c s t. Apply (C (b -> c) s) n ((b -> c) -> s -> t) =>
+    Apply (C (b -> c) (a -> s)) (S n) ((b -> c) -> (a -> s) -> (a -> t))
+  where
+    apply _ _ = (.) . apply (undefined :: C (b -> c) s) (undefined :: n)
+
+-- Extended function composition e.g.
+-- compose zero = (.)
+-- compose zero f g x = f (g x)
+-- compose one f g x y = f (g x y)
+
+class Compose n a b c | n a b -> c where
+    compose :: n -> a -> b -> c
+
+instance forall n a b c d e f. (ComposeType n (b -> c) (a -> f) (d -> e),
+        Apply (C (b -> c) (a -> f)) n ((b -> c) -> (a -> f) -> (d -> e))
+    ) =>
+    Compose n (b -> c) (a -> f) (d -> e)
+  where
+    compose _ = apply (undefined :: C (b -> c) (a -> f)) (undefined :: n)
+
+class FlipType n a b | n a -> b
+
+instance (TypeCast d a, TypeCast e b, TypeCast f c) =>
+    FlipType Z (a -> b -> c) ((d -> e -> f) -> (e -> d -> f))
+
+instance
+    FlipType n f ((a -> b -> c -> d) -> (b -> a -> c -> d)) =>
+    FlipType (S n) f ((b -> c -> d) -> (c -> b -> d))
+
+class RotType n a b | n a -> b
+
+instance TypeCast a b => RotType Z a b
+instance (TypeCast d b, TypeCast e a, TypeCast f c) =>
+    RotType (S Z) (a -> b -> c) (d -> e -> f)
+instance (RotType (S n) b g,
+        FlipType (S n) a ((d -> e -> f) -> (e -> d -> f)),
+        ComposeType n ((d -> e -> f) -> (e -> d -> f)) a b
+    ) =>
+    RotType (S (S n)) a g
+
+data R a
+
+instance Apply (R a) Z (a -> a) where
+    apply _ _ = id
+instance Apply (R (b -> a -> c)) (S Z) ((b -> a -> c) -> (a -> b -> c)) where
+    apply _ _ = flip
+instance forall n a b c d e f. (Apply (R b) (S n) (b -> f),
+        FlipType (S n) a ((c -> d -> e) -> (d -> c -> e)),
+        Compose n ((c -> d -> e) -> (d -> c -> e)) a b
+    ) =>
+        Apply (R a) (S (S n)) (a -> f) where
+    apply _ _ =
+        apply (undefined :: R b) (undefined :: S n) .
+            compose (undefined :: n) (flip :: ((c -> d -> e) -> (d -> c -> e)))
+
+-- <rot n f> passes its first argument as the (n + 1)th argument
+-- to <f>, rotating the intervening arguments along
+-- e.g. <rot one> = flip
+
+class Rot n a b | n a -> b where
+    rot :: n -> a -> b
+
+instance forall n a b. (
+        RotType n a b,
+        Apply (R a) n (a -> b)
+    ) =>
+        Rot n a b where
+    rot _ = apply (undefined :: R a) (undefined :: n)
+
+-- vim: expandtab:tabstop=4:shiftwidth=4
+ Control/Combine/SmallCheck.hs view
@@ -0,0 +1,9 @@+module Control.Combine.SmallCheck where
+
+import Control.Combine as C
+import Test.SmallCheck as SC
+
+prop_rot2_works a b c = rot C.two (,,) a b c == (b, c, a)
+    where types = (a :: Bool, b :: Bool, c :: Bool)
+
+-- vim: expandtab:tabstop=4:shiftwidth=4
+ Control/Combine/Test.hs view
@@ -0,0 +1,86 @@+{-# LANGUAGE EmptyDataDecls, FlexibleContexts #-}
+-- -fallow-undecidable-instances
+-- .$Header: c:/Source/Haskell/Combine/Control/Combine/RCS/Test.hs,v 1.4 2009/12/09 00:55:34 dosuser Exp dosuser $
+module Control.Combine.Test where
+
+import Data.Type.Eq
+
+import Control.Combine hiding (C)
+
+data A
+data B
+data C
+data D
+data E
+
+type Fn = A -> B -> C -> D -> E
+
+t1 :: (FlipType Z Fn ((a -> b -> c) -> (b -> a -> c)),
+        TypeCast ((a -> b -> c) -> (b -> a -> c))
+            (Fn -> B -> A -> C -> D -> E)) =>
+    (a -> b -> c) -> (b -> a -> c)
+t1 = flip
+t2 :: (FlipType (S Z) Fn ((a -> b -> c) -> (b -> a -> c)),
+        TypeCast ((a -> b -> c) -> (b -> a -> c))
+            ((B -> C -> D -> E) -> (C -> B -> D -> E))) =>
+    (a -> b -> c) -> (b -> a -> c)
+t2 = flip
+t3 :: (FlipType (S (S Z)) Fn ((a -> b -> c) -> (b -> a -> c)),
+        TypeCast ((a -> b -> c) -> (b -> a -> c))
+            ((C -> D -> E) -> (D -> C -> E))) =>
+    (a -> b -> c) -> (b -> a -> c)
+t3 = flip
+
+fn :: Fn
+fn = undefined
+
+fl :: FlipType n f ((a -> b -> c) -> (b -> a -> c)) =>
+    n -> f -> ((a -> b -> c) -> (b -> a -> c))
+fl _ _ = flip
+
+t4 :: Fn -> B -> A -> C -> D -> E
+t4 = fl zero fn
+t5 :: (B -> C -> D -> E) -> (C -> B -> D -> E)
+t5 = fl one fn
+t6 :: (C -> D -> E) -> (D -> C -> E)
+t6 = fl two fn
+
+{-
+ab :: A -> B
+ab = undefined
+bc :: B -> C
+bc = undefined
+cd :: C -> D
+cd = undefined
+de :: D -> E
+de = undefined
+
+abc :: A -> B -> C
+abc = undefined
+abcd :: A -> B -> C -> D
+abcd = undefined
+-}
+
+t7 :: (B -> C) -> (A -> B) -> (A -> C)
+t7 = compose zero
+t8 :: (C -> D) -> (A -> B -> C) -> (A -> B -> D)
+t8 = compose one
+t9 :: (D -> E) -> (A -> B -> C -> D) -> (A -> B -> C -> E)
+t9 = compose two
+
+rt :: RotType n a b => n -> a -> b
+rt = undefined
+
+t10 :: A -> B -> C -> D -> E
+t10 = rot zero fn
+t11 :: B -> A -> C -> D -> E
+t11 = rot one fn
+t12 :: C -> A -> B -> D -> E
+t12 = rot two fn
+t13 :: D -> A -> B -> C -> E
+t13 = rot three fn
+
+t14 :: (C -> D -> E) -> (A -> B -> D) -> (A -> B -> C -> E)
+t14 = compose one . rot one
+
+-- vim: expandtab:tabstop=4:shiftwidth=4
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright Iain Alexander 2010.
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are
+met:
+
+    * Redistributions of source code must retain the above copyright
+      notice, this list of conditions and the following disclaimer.
+
+    * 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.
+
+    * Neither the name of Iain Alexander nor the names of other
+      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.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple
+main = defaultMain
+ function-combine.cabal view
@@ -0,0 +1,24 @@+Name:            function-combine
+Version:         0.0.1
+Cabal-version:   >= 1.2
+Build-Type:      Simple
+Synopsis:        Combining functions
+Description:     MPTC/FD generalisations of (.) and flip
+Category:        Control
+License:         BSD3
+License-File:    LICENSE
+Author:          Iain Alexander <ia@stryx.demon.co.uk>
+Maintainer:      Iain Alexander <ia@stryx.demon.co.uk>
+Build-Type:      Simple
+Extra-source-files:   Control/Combine/Test.hs
+                    , Control/Combine/SmallCheck.hs
+                    , .ghci
+Tested-with:     GHC==6.4.1, GHC==6.6.1, GHC==6.8.3, GHC==6.10.4, GHC==6.12.3
+               , GHC==7.0.1
+Library
+    Exposed-Modules:   Control.Combine
+    if impl(ghc < 6.6.1)
+        Extensions:      UndecidableInstances
+        Ghc-options:     -fglasgow-exts
+    Build-Depends:   base < 5, data-type < 0.1
+-- vim: expandtab:tabstop=4:shiftwidth=4