From 32358274794296f86496cefbcec044626c833ee6 Mon Sep 17 00:00:00 2001 From: timpierson Date: Sat, 10 Mar 2018 12:47:22 -0500 Subject: [PATCH] Moving to DMaps to memo shapes --- diffhask.cabal | 4 + src/Core.hs | 367 +++++++++++---------- src/Internal/Internal.hs | 295 +++++++++++------ src/Internal/NumHask/Algebra/.#Additive.hs | 1 - src/Internal/NumHask/Algebra/Additive.hs | 223 +++++++------ src/Internal/NumHask/Prelude.hs | 44 +-- stack.yaml | 11 + test/.#Spec.hs | 1 - 8 files changed, 542 insertions(+), 404 deletions(-) delete mode 120000 src/Internal/NumHask/Algebra/.#Additive.hs delete mode 120000 test/.#Spec.hs diff --git a/diffhask.cabal b/diffhask.cabal index 6ad40f9..8096b85 100644 --- a/diffhask.cabal +++ b/diffhask.cabal @@ -49,6 +49,10 @@ library , dependent-map , numhask , numhask-array + , HMap + , data-variant + , heterolist + diff --git a/src/Core.hs b/src/Core.hs index 8d3513f..3649237 100644 --- a/src/Core.hs +++ b/src/Core.hs @@ -8,6 +8,7 @@ {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE Rank2Types #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE UndecidableInstances #-} @@ -25,7 +26,10 @@ import Internal.NumHask.Prelude hiding (State, diff, evalState, import Lens.Micro ((%~), (&), (.~), (^.)) import Prelude (error) import qualified NumHask.Prelude as P - +import Data.Unique +import qualified Data.HMap as HM +import qualified Data.HKey as HM +import qualified Data.Variant as DV --FIXME: prune redundancy -- type AdditiveDifferentiable t r @@ -169,39 +173,42 @@ import qualified NumHask.Prelude as P -- Get Tangent -t :: forall r a. (AdditiveUnital (D r a) r a) - => D r a - -> Computation r a (Tangent r a) +t :: forall r s a. (AdditiveUnital (D s r a) r a) + => D s r a + -> Computation s a (Tangent s r a) t = \case - D _ -> pure (zero :: (Tangent r a)) - DF _ at _ -> pure (at :: (Tangent r a)) + D _ -> pure (zero :: (Tangent s r a)) + DF _ at _ -> pure (at :: (Tangent s r a)) DR {} -> error "Can't get tangent of a reverse node" initComp :: forall a r. (P.Fractional a) => ComputationState r a -initComp = ComputationState (Tag 0) (UID 0) M.empty M.empty (1e-6 :: a) 1000 +initComp = ComputationState (Tag 0) (UID 0) M.empty HM.empty M.empty (1e-6 :: a) 1000 -mkForward :: () => Tag -> Tangent r a -> Primal r a -> D r a +mkForward :: () => Tag -> Tangent s r a -> Primal s r a -> D s r a mkForward i tg d = DF d tg i -mkReverse :: ( Trace Noop r a) => Tag -> D r a -> Computation r a (D r a) +mkReverse :: ( Trace Noop s r a) => Tag -> D s r a -> Computation s a (D s r a) mkReverse i d = r d (N Noop) i -instance Trace Noop r a where - pushEl _ _ = pure [] - resetEl _ = pure [] - -addDeltas :: - ( Additive (D r a) (D r a) r a - , AdditiveModule r (D r a) (D r a) a - , AdditiveBasis r (D r a) (D r a) a +instance Trace Noop s r a where + pushAlg _ _ = pure [] + resetAlg _ = pure [] + +addDeltas :: + ( Additive (D s r a) (D s r a) r a + , AdditiveModule r (D s r a) (D s r a) a + , AdditiveBasis r (D s r a) (D s r a) a + , Additive (D s r a) (D s rr a) rrr a + , AdditiveModule rrr (D s r a) (D s rr a) a + , AdditiveBasis rrr (D s r a) (D s rr a) a ) - => D r a - -> D r a - -> Computation r a (D r a) + => D s r a + -> D s rr a + -> Computation s a (D s rrr a) addDeltas a b = case (a, b) of (D xa, D xb) -> a + b @@ -210,29 +217,41 @@ addDeltas a b = (Dm ma, Dm mb) -> a .+. b applyDelta :: - ( Additive (D r a) (D r a) r a - , AdditiveModule r (D r a) (D r a) a - , AdditiveBasis r (D r a) (D r a) a + ( Additive (D s r a) (D s r a) r a + , AdditiveModule r (D s r a) (D s r a) a + , AdditiveBasis r (D s r a) (D s r a) a ) => UID - -> D r a - -> Adjoints r a - -> Maybe (Computation r a (D r a)) -applyDelta tag dlta adjs = - case M.lookup tag adjs of - Just v -> Just rval - where rval = do - r <- addDeltas v dlta - modify - (\st -> st & adjoints .~ M.update (const . Just $ r) tag adjs) - return r - Nothing -> Nothing - -decrementFanout :: UID -> Fanouts -> (Maybe Tag, Fanouts) + -> D s r a + -> (Computation s a (D s rr a)) +applyDelta uniq dlta = do + st <- cGet + let adjs = st ^. adjoints + let km = st ^. uidKeyMap + case M.lookup uniq km of + Just (sk) -> + case sk of + (SomeKey (k :: HM.HKey s (D s rk a))) -> + case HM.lookup k adjs of + Just (v :: (D s rk a)) -> do + (r :: (D s rd a)) <- addDeltas v dlta + nk <- HM.getKey + lift $ + modify + (\st -> + st & adjoints .~ HM.update (const . Just $ r) nk adjs & + uidKeyMap %~ + (M.insert uniq (SomeKey nk))) + pure r + _ -> error "Couldn't find HKey in adjoints!" + _ -> error $ "Couldn't find HKey for id " ++ show uniq + + +decrementFanout :: UID -> Fanouts s a -> (Maybe Tag, Fanouts s a) decrementFanout = M.updateLookupWithKey (\_ (Tag v) -> Just . Tag $ v P.- 1) -incrementFanout :: UID -> Computation r a Tag +incrementFanout :: UID -> Computation s a Tag incrementFanout u = do st <- get let (mf, a) = @@ -240,20 +259,21 @@ incrementFanout u = do (case mf of Nothing -> do - put (st & fanouts %~ M.insert u (Tag 1)) + cPut (st & fanouts %~ M.insert u (Tag 1)) return $ Tag 1 Just f -> do - put (st & fanouts %~ const a) + cPut (st & fanouts %~ const a) return f) -zeroAdj :: - forall r a. (AdditiveUnital (D r a) r a) - => UID - -> Computation r a () +zeroAdj :: -- forall r s a. (AdditiveUnital (D s r a) r a) + -- => + UID + -> Computation s a () zeroAdj uniq = do - modify (\st -> st & adjoints %~ M.insert uniq ((zero :: D r a))) + (nk :: HM.HKey s (D s r a)) <- HM.getKey + lift $ modify (\st -> st & uidKeyMap %~ ( M.insert uniq (SomeKey nk))& adjoints %~ HM.insert nk ((zero :: D s r a))) -reset :: (AdditiveUnital (D r a) r a, Show a) => [D r a] -> Computation r a () +reset :: (AdditiveUnital (D s r a) r a, Show a) => [D s r a] -> Computation s a () reset l = case l of [] -> return () @@ -264,30 +284,29 @@ reset l = if fanout == Tag 1 then do zeroAdj uniq - x <- resetEl o + x <- resetAlg o reset $ x `mappend` xs -- verify this else reset xs reset xs _ -> reset xs --- recursively pushes nodes onto the reverse mode stack and evaluates partials +-- recursively pushes nodes onto the reverse mode stack and composes partials at node push :: - ( AdditiveUnital (D r a) r a + ( AdditiveUnital (D s r a) r a , Show a - , Additive (D r a) (D r a) r a - , AdditiveModule r (D r a) (D r a) a - , AdditiveBasis r (D r a) (D r a) a + , Additive (D s r a) (D s r a) r a + , AdditiveModule r (D s r a) (D s r a) a + , AdditiveBasis r (D s r a) (D s r a) a ) - => [(D r a, D r a)] - -> Computation r a () + => [(D s r a, D s r a)] + -> Computation s a () push l = case l of [] -> return () ((dl, da):xs) -> case da of DR _ o _ uniq -> do - st <- gets ( ^. adjoints ) - let mv = applyDelta uniq dl st + let mv = applyDelta uniq dl case mv of Just cdA -> do dA <- cdA @@ -296,146 +315,146 @@ push l = put (nst1 & fanouts .~ aa) if fn == Tag 0 then do - pd <- pushEl o dA + pd <- pushAlg o dA push $ pd `mappend` xs else push xs Nothing -> error "key not found in adjoints!" _ -> push xs reverseReset :: - ( AdditiveUnital (D r a) r a + ( AdditiveUnital (D s r a) r a , Show a - , Additive (D r a) (D r a) r a - , AdditiveModule r (D r a) (D r a) a - , AdditiveBasis r (D r a) (D r a) a + , Additive (D s r a) (D s r a) r a + , AdditiveModule r (D s r a) (D s r a) a + , AdditiveBasis r (D s r a) (D s r a) a ) - => D r a - -> Computation r a () + => D s r a + -> Computation s a () reverseReset d = do - modify (& fanouts .~ M.empty ) + lift $ modify (& fanouts .~ M.empty ) reset [ d] reverseProp :: - ( AdditiveUnital (D r a) r a + ( AdditiveUnital (D s r a) r a , Show a - , Additive (D r a) (D r a) r a - , AdditiveModule r (D r a) (D r a) a - , AdditiveBasis r (D r a) (D r a) a + , Additive (D s r a) (D s r a) r a + , AdditiveModule r (D s r a) (D s r a) a + , AdditiveBasis r (D s r a) (D s r a) a ) - => D r a - -> D r a - -> Computation r a () + => D s r a + -> D s r a + -> Computation s a () reverseProp v d = do reverseReset d push [( v, d)] {-# INLINE primalTanget #-} primalTanget :: - (Show a, AdditiveUnital (D r a) r a) - => D r a - -> Computation r a (D r a, Tangent r a) + (Show a, AdditiveUnital (D s r a) r a) + => D s r a + -> Computation s a (D s r a, Tangent s r a) primalTanget d = do ct <- t d pure (p d, ct) adjoint :: - forall a r. (Show a, AdditiveUnital (D r a) r a) - => D r a - -> Computation r a (D r a) + forall a s r. (Show a, AdditiveUnital (D s r a) r a) + => D s r a + -> Computation s a (D s r a) adjoint d = case d of DR _ _ _ uniq -> do - ma <- gets (\st -> M.lookup uniq (st ^. adjoints)) + ma <- lift $ gets (\st -> M.lookup uniq (st ^. adjoints)) case ma of Just a -> return a Nothing -> error "Adjoint not in map!" DF{} -> error "Cannot get adjoint value of DF. Use makeReverse on this node when composing the computation." - D _ -> pure (zero :: D r a) + D _ -> pure (zero :: D s r a) runComputation :: () => State s a -> s -> (a, s) runComputation = runState -compute :: (P.RealFrac a) => Computation r a (b) -> b +compute :: (P.RealFrac a) => Computation s a (b) -> b compute f = evalState f initComp {-# INLINE computeAdjoints' #-} computeAdjoints' :: - forall a r. + forall a s r. ( Show a - , AdditiveUnital (D r a) r a - , MultiplicativeUnital (D r a) r a - , Additive (D r a) (D r a) r a - , AdditiveModule r (D r a) (D r a) a - , AdditiveBasis r (D r a) (D r a) a + , AdditiveUnital (D s r a) r a + -- , MultiplicativeUnital (D s r a) r a + , Additive (D s r a) (D s r a) r a + , AdditiveModule r (D s r a) (D s r a) a + , AdditiveBasis r (D s r a) (D s r a) a ) - => D r a - -> Computation r a () + => D s r a + -> Computation s a () computeAdjoints' d = do modify (\st -> st & adjoints .~ M.empty) - o <- pure (one :: D r a) + o <- pure (one :: D s r a) reverseProp o d {-# INLINE computeAdjoints #-} computeAdjoints :: ( Show a - , AdditiveUnital (D r a) r a - , MultiplicativeUnital (D r a) r a - , Additive (D r a) (D r a) r a - , AdditiveModule r (D r a) (D r a) a - , AdditiveBasis r (D r a) (D r a) a + , AdditiveUnital (D s r a) r a + -- , MultiplicativeUnital (D s r a) r a + , Additive (D s r a) (D s r a) r a + , AdditiveModule r (D s r a) (D s r a) a + , AdditiveBasis r (D s r a) (D s r a) a ) - => D r a - -> Computation r a (Adjoints r a) + => D s r a + -> Computation s a (Adjoints) computeAdjoints d = do computeAdjoints' d st <- get return $ st ^. adjoints {-# INLINE diff' #-} -diff' :: forall a r. +diff' :: forall a s r. ( Show a - , AdditiveUnital (D r a) r a - , MultiplicativeUnital (D r a) r a - , Additive (D r a) (D r a) r a - , AdditiveModule r (D r a) (D r a) a - , AdditiveBasis r (D r a) (D r a) a) - => (D r a -> Computation r a (D r a)) - -> D r a - -> Computation r a (D r a, Tangent r a) + , AdditiveUnital (D s r a) r a + -- , MultiplicativeUnital (D s r a) r a + , Additive (D s r a) (D s r a) r a + , AdditiveModule r (D s r a) (D s r a) a + , AdditiveBasis r (D s r a) (D s r a) a) + => (D s r a -> Computation s a (D s r a)) + -> D s r a + -> Computation s a (D s r a, Tangent s r a) diff' f x = do n <- getNextTag - o <- pure (one :: D r a) + o <- pure (one :: D s r a) fout <- f $ mkForward n o x primalTanget fout {-# INLINE diff #-} diff :: ( Show a - , AdditiveUnital (D r a) r a - , MultiplicativeUnital (D r a) r a - , Additive (D r a) (D r a) r a - , AdditiveModule r (D r a) (D r a) a - , AdditiveBasis r (D r a) (D r a) a) - => (D r a -> Computation r a (D r a)) - -> D r a - -> Computation r a (Tangent r a) + , AdditiveUnital (D s r a) r a + -- , MultiplicativeUnital (D s r a) r a + , Additive (D s r a) (D s r a) r a + , AdditiveModule r (D s r a) (D s r a) a + , AdditiveBasis r (D s r a) (D s r a) a) + => (D s r a -> Computation s a (D s r a)) + -> D s r a + -> Computation s a (Tangent s r a) diff f x = snd <$> diff' f x {-# INLINE diffn #-} diffn :: ( Show a - , AdditiveUnital (D r a) r a - , MultiplicativeUnital (D r a) r a - , Additive (D r a) (D r a) r a - , AdditiveModule r (D r a) (D r a) a - , AdditiveBasis r (D r a) (D r a) a + , AdditiveUnital (D s r a) r a + -- , MultiplicativeUnital (D s r a) r a + , Additive (D s r a) (D s r a) r a + , AdditiveModule r (D s r a) (D s r a) a + , AdditiveBasis r (D s r a) (D s r a) a ) => Int - -> (D r a -> Computation r a (D r a)) - -> D r a - -> Computation r a (Tangent r a) + -> (D s r a -> Computation s a (D s r a)) + -> D s r a + -> Computation s a (Tangent s r a) diffn n f x = if n < 0 then error "Cannot get the nth derivitive when n is negative!" @@ -445,16 +464,16 @@ diffn n f x = where go :: ( Show a - , AdditiveUnital (D r a) r a - , MultiplicativeUnital (D r a) r a - , Additive (D r a) (D r a) r a - , AdditiveModule r (D r a) (D r a) a - , AdditiveBasis r (D r a) (D r a) a + , AdditiveUnital (D s r a) r a + -- , MultiplicativeUnital (D s r a) r a + , Additive (D s r a) (D s r a) r a + , AdditiveModule r (D s r a) (D s r a) a + , AdditiveBasis r (D s r a) (D s r a) a ) => Int - -> (D r a -> Computation r a (D r a)) - -> D r a - -> Computation r a (Tangent r a) + -> (D s r a -> Computation s a (D s r a)) + -> D s r a + -> Computation s a (Tangent s r a) go n f = case n of 0 -> diff f @@ -463,16 +482,16 @@ diffn n f x = {-# INLINE diffn' #-} diffn' :: ( Show a - , AdditiveUnital (D r a) r a - , MultiplicativeUnital (D r a) r a - , Additive (D r a) (D r a) r a - , AdditiveModule r (D r a) (D r a) a - , AdditiveBasis r (D r a) (D r a) a + , AdditiveUnital (D s r a) r a + -- , MultiplicativeUnital (D s r a) r a + , Additive (D s r a) (D s r a) r a + , AdditiveModule r (D s r a) (D s r a) a + , AdditiveBasis r (D s r a) (D s r a) a ) => Int - -> (D r a -> Computation r a (D r a)) - -> D r a - -> Computation r a (D r a, (Tangent r a)) + -> (D s r a -> Computation s a (D s r a)) + -> D s r a + -> Computation s a (D s r a, (Tangent s r a)) diffn' n f x = do it <- f x again <- diffn n f x @@ -480,17 +499,17 @@ diffn' n f x = do {-# INLINE grad' #-} grad' :: - ( Trace Noop r a + ( Trace Noop s r a , Show a - , AdditiveUnital (D r a) r a - , MultiplicativeUnital (D r a) r a - , Additive (D r a) (D r a) r a - , AdditiveModule r (D r a) (D r a) a - , AdditiveBasis r (D r a) (D r a) a + , AdditiveUnital (D s r a) r a + -- , MultiplicativeUnital (D s r a) r a + , Additive (D s r a) (D s r a) r a + , AdditiveModule r (D s r a) (D s r a) a + , AdditiveBasis r (D s r a) (D s r a) a ) - => (D r a -> Computation r a (D r a)) - -> D r a - -> Computation r a (D r a, (D r a)) + => (D s r a -> Computation s a (D s r a)) + -> D s r a + -> Computation s a (D s r a, (D s r a)) grad' f x = do ntg <- getNextTag xa <- mkReverse ntg x @@ -501,17 +520,17 @@ grad' f x = do {-# INLINE grad #-} grad :: - ( Trace Noop r a + ( Trace Noop s r a , Show a - , AdditiveUnital (D r a) r a - , MultiplicativeUnital (D r a) r a - , Additive (D r a) (D r a) r a - , AdditiveModule r (D r a) (D r a) a - , AdditiveBasis r (D r a) (D r a) a + , AdditiveUnital (D s r a) r a + -- , MultiplicativeUnital (D s r a) r a + , Additive (D s r a) (D s r a) r a + , AdditiveModule r (D s r a) (D s r a) a + , AdditiveBasis r (D s r a) (D s r a) a ) - => (D r a -> Computation r a (D r a)) - -> D r a - -> Computation r a (D r a) + => (D s r a -> Computation s a (D s r a)) + -> D s r a + -> Computation s a (D s r a) grad f x = do (_, g)<- grad' f x return g @@ -520,16 +539,16 @@ grad f x = do jacobian' :: ( Show a , Show a - , AdditiveUnital (D r a) r a - , MultiplicativeUnital (D r a) r a - , Additive (D r a) (D r a) r a - , AdditiveModule r (D r a) (D r a) a - , AdditiveBasis r (D r a) (D r a) a + , AdditiveUnital (D s r a) r a + -- , MultiplicativeUnital (D s r a) r a + , Additive (D s r a) (D s r a) r a + , AdditiveModule r (D s r a) (D s r a) a + , AdditiveBasis r (D s r a) (D s r a) a ) - => (D r a -> Computation r a (D r a)) - -> Tangent r a - -> Primal r a - -> Computation r a (D r a, Tangent r a) + => (D s r a -> Computation s a (D s r a)) + -> Tangent s r a + -> Primal s r a + -> Computation s a (D s r a, Tangent s r a) jacobian' f x v = do ntg <- getNextTag fout <- f $ mkForward ntg v x @@ -537,14 +556,14 @@ jacobian' f x v = do jacobian :: ( Show a - , AdditiveUnital (D r a) r a - , MultiplicativeUnital (D r a) r a - , Additive (D r a) (D r a) r a - , AdditiveModule r (D r a) (D r a) a - , AdditiveBasis r (D r a) (D r a) a + , AdditiveUnital (D s r a) r a + -- , MultiplicativeUnital (D s r a) r a + , Additive (D s r a) (D s r a) r a + , AdditiveModule r (D s r a) (D s r a) a + , AdditiveBasis r (D s r a) (D s r a) a ) - => (D r a -> Computation r a (D r a)) - -> Tangent r a - -> Primal r a - -> Computation r a (Tangent r a) + => (D s r a -> Computation s a (D s r a)) + -> Tangent s r a + -> Primal s r a + -> Computation s a (Tangent s r a) jacobian f x v = snd <$> jacobian' f x v diff --git a/src/Internal/Internal.hs b/src/Internal/Internal.hs index e8add2e..8444796 100644 --- a/src/Internal/Internal.hs +++ b/src/Internal/Internal.hs @@ -7,31 +7,41 @@ {-# LANGUAGE LambdaCase #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE OverloadedLists #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} - {-# LANGUAGE TypeFamilyDependencies #-} {-# LANGUAGE TypeInType #-} {-# LANGUAGE UndecidableInstances #-} module Internal.Internal (module Internal.Internal) where -import Control.Monad.State.Strict (State, evalState, get, gets, - modify, put, runState, (>=>)) -import qualified Data.Dependent.Map as DM (DMap, empty, insert, lookup, - update, updateLookupWithKey) +import Control.Monad.State.Strict (State, StateT, evalState, get, + gets, modify, put, runState, (>=>)) +import qualified Data.Dependent.Map as DM (DMap, GOrdering (..), empty, + insert, lookup, update, + updateLookupWithKey) +import Data.GADT.Compare ((:~:) (..), GCompare (..), + GEq (..)) +import qualified Data.HKey as HM +import qualified Data.HMap as HM import qualified Data.Map as M (Map, empty, insert, lookup, update, updateLookupWithKey) +import Data.Type.Equality (testEquality) +import Data.Unique +import GHC.Err +import GHC.Show import Lens.Micro ((%~), (&), (.~), (^.)) import Lens.Micro.TH (makeLenses) -import NumHask.Prelude hiding (State, abs, negate, signum, - (*), (+), (-), (/), Show, show) -import Protolude.Error +import qualified NumHask.Array as A +import NumHask.Prelude hiding (Show, State, StateT, + TypeRep, abs, negate, show, signum, + (*), (+), (-), (/)) import qualified NumHask.Prelude as E import qualified NumHask.Prelude as P -import GHC.Show -import GHC.Err +import Protolude.Error +import Type.Reflection (SomeTypeRep (..), TypeRep) -- import Data.Dependent.Sum -- import Data.Functor.Identity -- import Data.GADT.Compare @@ -40,99 +50,155 @@ import GHC.Err -- import Data.GADT.Show.TH -data ComputationState r a = ComputationState - { _nextTag :: !Tag +type family Container c where + Container (A.Array c s) = c + + + +data ComputationState s a = ComputationState + { + _nextTag :: !Tag , _nextUID :: !UID - , _adjoints :: Adjoints r a - , _fanouts :: Fanouts + , _uidKeyMap :: UIDKeyMap s a + , _adjoints :: Adjoints + , _fanouts :: Fanouts s a , _fpEps :: a , _maxFpIter :: Int } -type Computation r a = State (ComputationState r a) +type Computation s a = HM.KeyT s (State (ComputationState s a)) + +type family GetScope a where + GetScope (D s r t) = s + GetScope (Computation s t a) = s -data D r a where - D :: a -> D r a -- scalar - Dm :: r a -> D r a -- array - DF :: Primal r a -> Tangent r a -> Tag -> D r a - DR :: (Show op, Trace op r a) => D r a -> DualTrace op r a -> Tag -> UID -> D r a +data D s (r :: * -> *) a where + D :: a -> D s r a -- scalar + Dm :: r a -> D s r a -- array + DF :: Primal s r a -> Tangent s r a -> Tag -> D s r a + DR :: (Show op, Trace op s r a) => D s r a -> DualTrace op s r a -> Tag -> UID -> D s r a -instance (Show a, Show Tag, Show UID, Show (r a)) => Show (D r a) where +instance (Show a, Show (r a), Show UID) => Show (D s r a) where show (D a) = "D " ++ GHC.Show.show a show (Dm a) = "D " ++ GHC.Show.show (a) - show (DF p t ti) = "DF " ++ GHC.Show.show p ++ GHC.Show.show t ++ GHC.Show.show ti - show (DR p dt ti uid) = "DR " ++ GHC.Show.show p ++ GHC.Show.show dt ++ GHC.Show.show ti ++ GHC.Show.show uid + show (DF p t ti) = "DF " ++ GHC.Show.show p ++ GHC.Show.show t ++ (" Tag ") + show (DR p dt ti uid) = "DR " ++ GHC.Show.show p ++ GHC.Show.show dt ++ (" Tag ") ++ GHC.Show.show uid -type Primal r a = D r a -type Tangent r a = D r a +type Primal s r a = D s r a +type Tangent s r a = D s r a -type FptNode r a = (D r a, D r a, D r a, D r a) -- nodes needed for a fixpoint evaluation +type FptNode s r a = (D s r a, D s r a, D s r a, D s r a) -- nodes needed for a fixpoint evaluation --- FIXME: singleton types on the DualTrace / Arity combination would restrict at least resetEl to a single possible implementation. -class Trace op r a where - resetEl :: DualTrace op r a -> Computation r a [D r a] - resetEl (U _ a) = pure [a] - resetEl (B _ a b) = pure [a, b, a, b] - resetEl (IxU _ a _) = pure [a] - pushEl :: DualTrace op r a -> D r a -> Computation r a [(D r a, D r a)] - {-# MINIMAL (resetEl, pushEl) #-} +-- FIXME: singleton types on the DualTrace / Arity combination would restrict at least resetAlg to a single possible implementation. +class Trace op s r a where + resetAlg :: DualTrace op s r a -> Computation s a [D s r a] + resetAlg (U _ a) = pure [a] + resetAlg (B _ a b) = pure [a, b, a, b] + resetAlg (IxU _ a _) = pure [a] + pushAlg :: DualTrace op s r a -> D s r a -> Computation s a [(D s r a, D s r a)] + {-# MINIMAL (resetAlg, pushAlg) #-} data Noop = Noop deriving Show -- To store the adoint we have to keep track of the outputs of an operation as well as the expressions that yeild the dual of the input arguments -data DualTrace op r a where - N :: op -> DualTrace op r a - U :: op -> D r a -> DualTrace op r a - B :: op -> D r a -> D r a -> DualTrace op r a - IxU :: op -> D r a -> [Int] -> DualTrace op r a - FxP :: op -> FptNode r a -> DualTrace op r a - -instance (Show op, Show a, Show (r a)) => Show (DualTrace op r a) where +data DualTrace op s r a where + N :: op -> DualTrace op s r a + U :: op -> D s r a -> DualTrace op s r a + B :: op -> D s r a -> D s r a -> DualTrace op s r a + IxU :: op -> D s r a -> [Int] -> DualTrace op s r a + FxP :: op -> FptNode s r a -> DualTrace op s r a + +instance (Show op, Show (r a), Show a) => Show (DualTrace op s r a) where show (N o) = "N " ++ show o show (U o t ) = "U " ++ show o ++ show t -- ++ show c show (B o t tt) = "B " ++ show o ++ show t ++ show tt show (IxU o t ix ) = "IxU " ++ show o ++ show t ++ show ix show (FxP o (a, b, c, d)) = "Fxp " ++ show o ++ show a ++ show b ++ show c ++ show d -type Fanouts = M.Map UID Tag +type family Fst (ab :: (k1, k2)) :: k1 where + Fst '(a, b) = a -type Adjoints r a = M.Map UID (D r a) +type family Snd (ab :: (k1, k2)) :: k2 where + Snd '(a, b) = b -newtype Tag = Tag Int - deriving (Eq, Ord, Show) +newtype Uncurry f ab = + Uncurry (f (Fst ab) (Snd ab)) + + +instance GEq TypeRep where + geq = testEquality + +instance GCompare TypeRep where + gcompare t1 t2 = + case testEquality t1 t2 of + Just Refl -> DM.GEQ + Nothing -> + case compare (SomeTypeRep t1) (SomeTypeRep t2) of + LT -> DM.GLT + GT -> DM.GGT + EQ -> + GHC.Err.error + "impossible: 'testEquality' and 'compare' \ + \are inconsistent for TypeRep; report this \ + \as a GHC bug" + +newtype Packed s a r = + Packed (D s r a) + +type family Unpacked a where + Unpacked (Packed (D s r a)) = D s r a + +type Fanouts s a = M.Map UID TypeRep + +type Adjoints s a = M.Map UID (DM.DMap TypeRep (Packed s a)) + +newtype Tag = Tag Int deriving (Eq, Ord, Show) newtype UID = UID Int deriving (Eq, Ord, Show) makeLenses ''ComputationState -getNextTag :: Computation r a (Tag) -getNextTag = do - st <- get - let tg@(Tag t) = st ^. nextTag - put (st & nextTag .~ (Tag (t P.+ 1))) +cGet :: Computation s a (ComputationState s a) +cGet = lift get +cPut :: (ComputationState s a) -> Computation s a () +cPut = lift . put + +getNextTagKey :: Computation s a (Tag) +getNextTagKey = do + st <- cGet + let tg@(Tag i) = st ^. nextTag + -- nk <- HM.getKey + cPut + (st & nextTag .~ ((Tag $ i P.+ 1)) + -- & uidKeyMap .~ + -- (M.insert tg (SomeKey nk) (st ^. uidKeyMap)) + ) return tg -getNextUID :: Computation r a (UID) +getNextUID :: Computation s a (UID) getNextUID = do - st <- get + st <- cGet let tg@(UID t) = st ^. nextUID - put (st & nextUID .~ (UID (t P.+ 1))) + nk <- HM.getKey + cPut + (st & nextUID .~ (UID (t P.+ 1)) & uidKeyMap .~ + (M.insert tg (SomeKey nk) (st ^. uidKeyMap))) return tg -- Make a reverse node -r :: (Trace op r a, Show op) - => D r a - -> DualTrace op r a +r :: (Trace op s r a, Show op) + => D s r a + -> DualTrace op s r a -> Tag - -> Computation r a (D r a) + -> Computation s a (D s r a) r d op ai = do uid <- getNextUID return $ DR d op ai uid -- Get Primal -p :: D r a -> D r a +p :: D s r a -> D s r a p = \case D v -> D v @@ -141,7 +207,7 @@ p = DR d _ _ _ -> d -- Get deepest primal -pD :: D r a -> D r a +pD :: D s r a -> D s r a pD = \case D v -> D v @@ -149,14 +215,14 @@ pD = DF d _ _ -> pD d DR d _ _ _ -> pD d -instance (Eq a) => Eq (D r a) where +instance (Eq a) => Eq (D s r a) where d1 == d2 = pD d1 == pD d2 -instance (Ord a) => Ord (D r a) where +instance (Ord a) => Ord (D s r a) where d1 `compare` d2 = pD d1 `compare` pD d2 --- toNumeric :: D r a -> b +-- toNumeric :: D s r a -> b -- toNumeric d = -- case pD d of @@ -165,16 +231,25 @@ instance (Ord a) => Ord (D r a) where class FfMon op a where ff :: op -> a -> a -class MonOp op r a where +class RffMon op r a where rff :: op -> r a -> r a - fd :: (Computation r a ~ m) => op -> D r a -> m (D r a) - df :: (Computation r a ~ m) => op -> D r a -> D r a -> D r a -> m (D r a) + +class MonOp op s r a where + + fd :: (Computation s a ~ m) => op -> D s r a -> m (D s r a) + df :: + (Computation s a ~ m) + => op + -> D s r a + -> D s r a + -> D s r a + -> m (D s r a) -- {-#INLINE monOp #-} monOp :: - (MonOp op r a, FfMon op a, (Trace op r a), Show op) + (MonOp op s r a, FfMon op a, (Trace op s r a), Show op, RffMon op r a) => op - -> D r a - -> Computation r a (D r a) + -> D s r a + -> Computation s a (D s r a) monOp op a = case a of D ap -> return . D $ ff op ap @@ -187,57 +262,74 @@ monOp op a = cp <- fd op ap r cp (U op a) ai -class DfDaBin op r b c | b -> c where +class DfDaBin op s r b c | b -> c where df_da :: - (Computation r c ~ m) => op -> b -> D r c -> D r c -> D r c -> m (D r c) + (Computation s a ~ m) + => op + -> b + -> D s r c + -> D s r c + -> D s r c + -> m (D s r c) -class DfDbBin op r a c | a -> c where +class DfDbBin op s r a c | a -> c where df_db :: - (Computation r c ~ m) => op -> a -> D r c -> D r c -> D r c -> m (D r c) + (Computation s c ~ m) + => op + -> a + -> D s r c + -> D s r c + -> D s r c + -> m (D s r c) -class (Show op, E.AdditiveBasis r a, E.AdditiveModule r a) => FfBin op a r where +class (Show op, E.AdditiveBasis r a, E.AdditiveModule r a) => + FfBin op a r where rff_bin :: op -> r a -> r a -> r a -- Forward mode function for arrays - rff_bin op _ _ = GHC.Err.error $ "array x array operation is not defined for " ++ ( GHC.Show.show op) + rff_bin op _ _ = + GHC.Err.error $ + "array x array operation is not defined for " ++ (GHC.Show.show op) r_ff_bin :: op -> r a -> a -> r a -- For scalar x arrays - r_ff_bin op _ _ = GHC.Err.error $ "array x scalar operation is not defined for " ++ ( GHC.Show.show op) + r_ff_bin op _ _ = + GHC.Err.error $ + "array x scalar operation is not defined for " ++ (GHC.Show.show op) _ff_bin :: op -> a -> r a -> r a -- For scalar x arrays - _ff_bin op _ _ = GHC.Err.error $ "scalar x array operation is not defined for " ++ ( GHC.Show.show op) + _ff_bin op _ _ = + GHC.Err.error $ + "scalar x array operation is not defined for " ++ (GHC.Show.show op) - - -class DfBin op r a b c | a b -> c where - fd_bin :: (Computation r c ~ m) => op -> a -> b -> m (D r c) +class DfBin op s r a b c | a b -> c where + type BinOpShape a + fd_bin :: (Computation s c ~ m) => op -> a -> b -> m (D s r c) df_dab :: - (Computation r c ~ m) + (Computation s c ~ m) => op -> a -> b - -> (D r c) - -> (D r c) - -> (D r c) - -> (D r c) - -> (D r c) - -> m (D r c) + -> (D s r c) + -> (D s r c) + -> (D s r c) + -> (D s r c) + -> (D s r c) + -> m (D s r c) class (Show op) => BinOp op a where ff_bin :: op -> a -> a -> a binOp :: - ( - Trace op r a - , Computation r a ~ m + ( Trace op s r a + , Computation s a ~ m , Show op - , Trace op r a - , DfBin op r (D r a) (D r a) a - , DfDaBin op r (D r a) a - , DfDbBin op r (D r a) a + , Trace op s r a + , DfBin op s r (D s r a) (D s r a) a + , DfDaBin op s r (D s r a) a + , DfDbBin op s r (D s r a) a , FfBin op a r ) => op - -> (D r a) - -> (D r a) - -> m (D r a) + -> (D s r a) + -> (D s r a) + -> m (D s r a) -- {-#INLINE binOp #-} binOp op a b = do case a of @@ -297,7 +389,8 @@ class (Show op) => cdf <- df_da op b cp ap at return $ DF cp (cdf) ai EQ -> - GHC.Err.error "Forward and reverse AD r cannot run on the same level." + GHC.Err.error + "Forward and reverse AD s r cannot run on the same level." DR ap _ ai _ -> case b of D _ -> do @@ -308,7 +401,9 @@ class (Show op) => r (fda) (B op a b) ai DF bp bt bi -> case compare ai bi of - EQ -> GHC.Err.error "Forward and reverse AD cannot run on the same level." + EQ -> + GHC.Err.error + "Forward and reverse AD cannot run on the same level." LT -> do cp <- fd_bin op a bp cdf <- df_db op a cp bp bt diff --git a/src/Internal/NumHask/Algebra/.#Additive.hs b/src/Internal/NumHask/Algebra/.#Additive.hs deleted file mode 120000 index f858ff5..0000000 --- a/src/Internal/NumHask/Algebra/.#Additive.hs +++ /dev/null @@ -1 +0,0 @@ -timpierson@Tims-MBP-2.lan.16551 \ No newline at end of file diff --git a/src/Internal/NumHask/Algebra/Additive.hs b/src/Internal/NumHask/Algebra/Additive.hs index 13e08d4..ef2c686 100644 --- a/src/Internal/NumHask/Algebra/Additive.hs +++ b/src/Internal/NumHask/Algebra/Additive.hs @@ -41,6 +41,7 @@ import qualified NumHask.Prelude as E type AdditiveBasisConstraints r t = ( E.Num t , E.AdditiveBasis r t + , E.AdditiveInvertible (r t) , E.AdditiveGroupBasis r t , E.AdditiveGroupModule r t , E.AdditiveModule r t) @@ -49,11 +50,13 @@ type AdditiveBasisConstraints r t -- > ∀ a,b ∈ A: a `plus` b ∈ A -- -- law is true by construction in Haskell -class AdditiveMagma a b r t | a b -> t, a -> t, b -> t +class (GetScope a ~ GetScope b) => + AdditiveMagma a b r t | a b -> t, a -> t, b -> t --, a -> r, b -> r - , a b -> r - where -- Fundep: r and t can be determined by a, b, or a and b: scalar ops don't change shape and must have the same representation. - plus :: a -> b -> Computation r t (D r t) + , a b -> r + -- Fundep: r and t can be determined by a, b, or a and b: scalar ops don't change shape and must have the same representation. + where + plus :: a -> b -> Computation (GetScope b) t (D (GetScope a) r t) -- | Unital magma for addition. @@ -83,9 +86,9 @@ class AdditiveMagma a a r t => -- > ∀ a ∈ A: negate a ∈ A -- -- law is true by construction in Haskell -class AdditiveMagma a a r t => +class (AdditiveMagma a a r t ) => AdditiveInvertible a r t | a -> t, a -> r where - negate :: a -> Computation r t (D r t) + negate :: a -> Computation (GetScope a) t (D (GetScope a) r t) -- | Idempotent magma for addition. @@ -98,12 +101,12 @@ class AdditiveMagma a b r t => sum :: ( Additive a a r t - , Additive a (Computation r t (D r t)) r t + , Additive a (Computation (GetScope a) t (D (GetScope a) r t)) r t , P.Foldable f , AdditiveUnital a r t ) => f a - -> Computation r t (D r t) + -> Computation (GetScope a) t (D (GetScope a) r t) sum = P.foldr (+) zero -- | Additive is commutative, unital and associative under addition @@ -119,10 +122,11 @@ class ( AdditiveCommutative a r t , AdditiveAssociative a r t , AdditiveAssociative b r t , AdditiveMagma a b r t + , GetScope a ~GetScope b ) => Additive a b r t where infixl 6 + - (+) :: a -> b -> Computation r t (D r t) + (+) :: a -> b -> Computation (GetScope b) t (D (GetScope a) r t) a + b = plus a b @@ -131,15 +135,16 @@ class ( AdditiveCommutative a r t -- -- > negate a `plus` a = zero class ( AdditiveMagma a b r t - , AdditiveMagma (Computation r t (D r t)) a r t + , AdditiveMagma (Computation (GetScope b) t (D (GetScope a) r t)) a r t , AdditiveUnital b r t , AdditiveAssociative a r t , AdditiveAssociative b r t - , AdditiveInvertible b r t) + , AdditiveInvertible b r t + , GetScope a ~GetScope b) => AdditiveLeftCancellative a b r t where infixl 6 ~- - (~-) :: a -> b -> Computation r t (D r t) + (~-) :: a -> b -> Computation (GetScope b) t (D (GetScope a) r t) (~-) a b = negate b `plus` a -- | Non-commutative right minus @@ -148,12 +153,12 @@ class ( AdditiveMagma a b r t class ( AdditiveUnital b r t , AdditiveAssociative a r t , AdditiveInvertible b r t - , AdditiveMagma a (Computation r t (D r t)) r t - + , AdditiveMagma a (Computation (GetScope b) t (D (GetScope a) r t)) r t + , GetScope a ~GetScope b ) => AdditiveRightCancellative a b r t where infixl 6 -~ - (-~) :: a -> b -> Computation r t (D r t) + (-~) :: a -> b -> Computation (GetScope b) t (D (GetScope a) r t) (-~) a b = a `plus` negate b -- | Minus ('-') is reserved for where both the left and right cancellative laws hold. This then implies that the AdditiveGroup is also Abelian. @@ -166,12 +171,12 @@ class ( AdditiveUnital b r t -- > a + negate a = zero class ( Additive a b r t , AdditiveInvertible b r t - , AdditiveMagma a (Computation r t (D r t)) r t - + , AdditiveMagma a (Computation (GetScope b) t (D (GetScope a) r t)) r t + , GetScope a ~GetScope b ) => AdditiveGroup a b r t where infixl 6 - - (-) :: a -> b -> Computation r t (D r t) + (-) :: a -> b -> Computation (GetScope b) t (D (GetScope a) r t) (-) a b = a `plus` negate b data Add = Add deriving Show @@ -180,42 +185,42 @@ data Negate = Negate deriving Show -instance (AdditiveBasisConstraints r Float) => AdditiveMagma (Computation r Float (D r Float)) (Computation r Float (D r Float)) r Float where +instance (AdditiveBasisConstraints r Float) => AdditiveMagma (Computation s Float (D s r Float)) (Computation s Float (D s r Float)) r Float where plus a b = do aa <- a bb <- b binOp Add aa bb -instance (AdditiveBasisConstraints r Float) => AdditiveMagma (Computation r Float (D r Float)) (D r Float) r Float where +instance (AdditiveBasisConstraints r Float) => AdditiveMagma (Computation s Float (D s r Float)) (D s r Float) r Float where plus a b = do aa <- a binOp Add aa b -instance (AdditiveBasisConstraints r Float) => AdditiveMagma (D r Float) (Computation r Float (D r Float)) r Float where +instance (AdditiveBasisConstraints r Float) => AdditiveMagma (D s r Float) (Computation s Float (D s r Float)) r Float where plus a b = do bb <- b binOp Add a bb -instance (AdditiveBasisConstraints r Float) => AdditiveMagma (D r Float) (D r Float) r Float where +instance (AdditiveBasisConstraints r Float) => AdditiveMagma (D s r Float) (D s r Float) r Float where plus= binOp Add -instance (AdditiveBasisConstraints r Double) => AdditiveMagma (Computation r Double (D r Double)) (Computation r Double (D r Double)) r Double where +instance (AdditiveBasisConstraints r Double) => AdditiveMagma (Computation s Double (D s r Double)) (Computation s Double (D s r Double)) r Double where plus a b = do aa <- a bb <- b binOp Add aa bb -instance (AdditiveBasisConstraints r Double) => AdditiveMagma (Computation r Double (D r Double)) (D r Double) r Double where +instance (AdditiveBasisConstraints r Double) => AdditiveMagma (Computation s Double (D s r Double)) (D s r Double) r Double where plus a b = do aa <- a binOp Add aa b -instance (AdditiveBasisConstraints r Double) => AdditiveMagma (D r Double) (Computation r Double (D r Double)) r Double where +instance (AdditiveBasisConstraints r Double) => AdditiveMagma (D s r Double) (Computation s Double (D s r Double)) r Double where plus a b = do bb <- b binOp Add a bb -instance (AdditiveBasisConstraints r Double) => AdditiveMagma (D r Double) (D r Double) r Double where +instance (AdditiveBasisConstraints r Double) => AdditiveMagma (D s r Double) (D s r Double) r Double where plus = binOp Add instance (E.Additive a) => BinOp Add a where @@ -230,122 +235,128 @@ instance (E.AdditiveBasis r a, E.AdditiveModule r a) => FfBin Add a r where {-# INLINE _ff_bin #-} _ff_bin _ a b = a E.+. b -instance DfDaBin Add r (D r a) a where +instance DfDaBin Add s r (D s r a) a where {-# INLINE df_da #-} df_da _ _ _ _ at = pure at -instance DfDbBin Add r (D r a) a where +instance DfDbBin Add s r (D s r a) a where {-# INLINE df_db #-} df_db _ _ _ _ bt = pure bt -instance (E.AdditiveBasis r a, E.AdditiveModule r a, E.Num a) => DfBin Add r (D r a) (D r a) a where +instance (E.AdditiveBasis r a, E.AdditiveModule r a, E.Num a) => DfBin Add s r (D s r a) (D s r a) a where {-# INLINE fd_bin #-} fd_bin _ a b = binOp Add a b {-# INLINE df_dab #-} df_dab _ _ _ _ _ at _ bt = binOp Add at bt -instance Trace Add r a where - pushEl (B _ a b) dA = pure [(dA, a), (dA, b), (dA, a), (dA, b)] - resetEl (B _ a b) = pure [a, b, a, b] +instance Trace Add s r a where + pushAlg (B _ a b) dA = pure [(dA, a), (dA, b), (dA, a), (dA, b)] + resetAlg (B _ a b) = pure [a, b, a, b] instance (AdditiveBasisConstraints r Double) => - AdditiveUnital (D r Double) r Double where + AdditiveUnital (D s r Double) r Double where zero = D 0 -instance (AdditiveBasisConstraints r Float) => AdditiveUnital (D r Float) r Float where +instance (AdditiveBasisConstraints r Float) => AdditiveUnital (D s r Float) r Float where zero = D 0 -instance (AdditiveBasisConstraints r Double) => AdditiveUnital (Computation r Double (D r Double)) r Double where +instance (AdditiveBasisConstraints r Double) => AdditiveUnital (Computation s Double (D s r Double)) r Double where zero = P.pure P.$ D 0 -instance (AdditiveBasisConstraints r Float) => AdditiveUnital (Computation r Float (D r Float)) r Float where +instance (AdditiveBasisConstraints r Float) => AdditiveUnital (Computation s Float (D s r Float)) r Float where zero = P.pure P.$ D 0 -instance (AdditiveBasisConstraints r Double) => AdditiveAssociative (D r Double) r Double +instance (AdditiveBasisConstraints r Double) => AdditiveAssociative (D s r Double) r Double -instance (AdditiveBasisConstraints r Double) => AdditiveAssociative (Computation r Double (D r Double)) r Double +instance (AdditiveBasisConstraints r Double) => AdditiveAssociative (Computation s Double (D s r Double)) r Double -instance (AdditiveBasisConstraints r Float) => AdditiveAssociative (D r Float) r Float +instance (AdditiveBasisConstraints r Float) => AdditiveAssociative (D s r Float) r Float -instance (AdditiveBasisConstraints r Float) => AdditiveAssociative (Computation r Float (D r Float)) r Float +instance (AdditiveBasisConstraints r Float) => AdditiveAssociative (Computation s Float (D s r Float)) r Float -instance (AdditiveBasisConstraints r Double) => AdditiveCommutative (D r Double) r Double +instance (AdditiveBasisConstraints r Double) => AdditiveCommutative (D s r Double) r Double -instance (AdditiveBasisConstraints r Float) => AdditiveCommutative (D r Float) r Float +instance (AdditiveBasisConstraints r Float) => AdditiveCommutative (D s r Float) r Float -instance (AdditiveBasisConstraints r Double) => AdditiveCommutative (Computation r Double (D r Double)) r Double +instance (AdditiveBasisConstraints r Double) => AdditiveCommutative (Computation s Double (D s r Double)) r Double -instance (AdditiveBasisConstraints r Float) => AdditiveCommutative (Computation r Float (D r Float)) r Float +instance (AdditiveBasisConstraints r Float) => AdditiveCommutative (Computation s Float (D s r Float)) r Float -instance (AdditiveBasisConstraints r Double) => AdditiveInvertible (Computation r Double (D r Double)) r Double where +instance (AdditiveBasisConstraints r Double) => AdditiveInvertible (Computation s Double (D s r Double)) r Double where negate a = do aa <- a monOp Negate aa -instance (AdditiveBasisConstraints r Float) => AdditiveInvertible (Computation r Float (D r Float)) r Float where +instance (AdditiveBasisConstraints r Float) => AdditiveInvertible (Computation s Float (D s r Float)) r Float where negate a = do aa <- a monOp Negate aa -instance (AdditiveBasisConstraints r Double) => AdditiveInvertible (D r Double) r Double where +instance (AdditiveBasisConstraints r Double) => AdditiveInvertible (D s r Double) r Double where negate = monOp Negate -instance (AdditiveBasisConstraints r Float) => AdditiveInvertible (D r Float) r Float where +instance (AdditiveBasisConstraints r Float) => AdditiveInvertible (D s r Float) r Float where negate = monOp Negate instance (E.AdditiveInvertible a) => FfMon Negate a where {-# INLINE ff #-} ff _ a = P.negate a -instance (E.AdditiveInvertible a, AdditiveInvertible (D r a) r a, E.Num a) => MonOp Negate r a where +instance (E.AdditiveInvertible (r a)) => RffMon Negate r a where + {-# INLINE rff #-} + rff _ a = P.negate a + +instance (E.AdditiveInvertible a + , AdditiveInvertible (D s r a) r a + , E.Num a, E.AdditiveInvertible (r a)) => MonOp Negate s r a where {-# INLINE fd #-} fd _ a = monOp Negate a {-# INLINE df #-} df _ _ _ at = monOp Negate at -instance (AdditiveInvertible (D r a) r a, E.Num a) => Trace Negate r a where - pushEl (U _ a) dA = do +instance (AdditiveInvertible (D s r a) r a, E.Num a) => Trace Negate s r a where + pushAlg (U _ a) dA = do cda <- negate dA pure [(cda, a)] - resetEl (U _ a) = pure [a] + resetAlg (U _ a) = pure [a] -instance (AdditiveBasisConstraints r Double) => Additive (D r Double) (D r Double) r Double +instance (AdditiveBasisConstraints r Double) => Additive (D s r Double) (D s r Double) r Double -instance (AdditiveBasisConstraints r Double) => Additive (Computation r Double (D r Double)) (D r Double) r Double +instance (AdditiveBasisConstraints r Double) => Additive (Computation s Double (D s r Double)) (D s r Double) r Double -instance (AdditiveBasisConstraints r Double) => Additive (D r Double) (Computation r Double (D r Double)) r Double +instance (AdditiveBasisConstraints r Double) => Additive (D s r Double) (Computation s Double (D s r Double)) r Double -instance (AdditiveBasisConstraints r Float) => Additive (D r Float) (D r Float) r Float +instance (AdditiveBasisConstraints r Float) => Additive (D s r Float) (D s r Float) r Float -instance (AdditiveBasisConstraints r Float) => Additive (D r Float) (Computation r Float (D r Float)) r Float +instance (AdditiveBasisConstraints r Float) => Additive (D s r Float) (Computation s Float (D s r Float)) r Float -instance (AdditiveBasisConstraints r Float) => Additive (Computation r Float (D r Float)) (D r Float) r Float +instance (AdditiveBasisConstraints r Float) => Additive (Computation s Float (D s r Float)) (D s r Float) r Float -instance (AdditiveBasisConstraints r Double) => Additive (Computation r Double (D r Double)) (Computation r Double (D r Double)) r Double +instance (AdditiveBasisConstraints r Double) => Additive (Computation s Double (D s r Double)) (Computation s Double (D s r Double)) r Double -instance (AdditiveBasisConstraints r Float) => Additive (Computation r Float (D r Float)) (Computation r Float (D r Float)) r Float +instance (AdditiveBasisConstraints r Float) => Additive (Computation s Float (D s r Float)) (Computation s Float (D s r Float)) r Float -instance (AdditiveBasisConstraints r Double) => AdditiveGroup (D r Double) (D r Double) r Double +instance (AdditiveBasisConstraints r Double) => AdditiveGroup (D s r Double) (D s r Double) r Double -instance (AdditiveBasisConstraints r Double) => AdditiveGroup (Computation r Double (D r Double)) (D r Double) r Double +instance (AdditiveBasisConstraints r Double) => AdditiveGroup (Computation s Double (D s r Double)) (D s r Double) r Double -instance (AdditiveBasisConstraints r Double) => AdditiveGroup (D r Double) (Computation r Double (D r Double)) r Double +instance (AdditiveBasisConstraints r Double) => AdditiveGroup (D s r Double) (Computation s Double (D s r Double)) r Double -instance (AdditiveBasisConstraints r Float) => AdditiveGroup (D r Float) (D r Float) r Float +instance (AdditiveBasisConstraints r Float) => AdditiveGroup (D s r Float) (D s r Float) r Float -instance (AdditiveBasisConstraints r Float) => AdditiveGroup (D r Float) (Computation r Float (D r Float)) r Float +instance (AdditiveBasisConstraints r Float) => AdditiveGroup (D s r Float) (Computation s Float (D s r Float)) r Float -instance (AdditiveBasisConstraints r Float) => AdditiveGroup (Computation r Float (D r Float)) (D r Float) r Float +instance (AdditiveBasisConstraints r Float) => AdditiveGroup (Computation s Float (D s r Float)) (D s r Float) r Float -instance (AdditiveBasisConstraints r Double) => AdditiveGroup (Computation r Double (D r Double)) (Computation r Double (D r Double)) r Double +instance (AdditiveBasisConstraints r Double) => AdditiveGroup (Computation s Double (D s r Double)) (Computation s Double (D s r Double)) r Double -instance (AdditiveBasisConstraints r Float) => AdditiveGroup (Computation r Float (D r Float)) (Computation r Float (D r Float)) r Float +instance (AdditiveBasisConstraints r Float) => AdditiveGroup (Computation s Float (D s r Float)) (Computation s Float (D s r Float)) r Float -- | Additive Module Laws @@ -357,13 +368,13 @@ instance (AdditiveBasisConstraints r Float) => AdditiveGroup (Computation r Floa class (Additive a b r t) => AdditiveModule r a b t where infixl 6 .+ - (.+) :: a -> b -> Computation r t (D r t) + (.+) :: a -> b -> Computation (GetScope b) t (D (GetScope a) r t) infixl 6 +. - (+.) :: a -> b -> Computation r t (D r t) + (+.) :: a -> b -> Computation (GetScope b) t (D (GetScope a) r t) instance (AdditiveBasisConstraints (A.Array c s) Double) => - AdditiveModule (A.Array c s) (Computation (A.Array c s) Double (D (A.Array c s) Double)) (D (A.Array c s) Double) Double where + AdditiveModule (A.Array c s) (Computation sc Double (D sc (A.Array c s) Double)) (D sc (A.Array c s) Double) Double where (.+) a b = do ca <- a binOp Add ca b @@ -372,7 +383,7 @@ instance (AdditiveBasisConstraints (A.Array c s) Double) => binOp Add ca b instance (AdditiveBasisConstraints (A.Array c s) Double) => - AdditiveModule (A.Array c s) (Computation (A.Array c s) Double (D (A.Array c s) Double)) (Computation (A.Array c s) Double (D (A.Array c s) Double)) Double where + AdditiveModule (A.Array c s) (Computation sc Double (D sc (A.Array c s) Double)) (Computation sc Double (D sc (A.Array c s) Double)) Double where (.+) a b = do ca <- a cb <- b @@ -384,12 +395,12 @@ instance (AdditiveBasisConstraints (A.Array c s) Double) => instance (AdditiveBasisConstraints (A.Array c s) Double) => - AdditiveModule (A.Array c s) (D (A.Array c s) Double) (D (A.Array c s) Double) Double where + AdditiveModule (A.Array c s) (D sc (A.Array c s) Double) (D sc (A.Array c s) Double) Double where (.+) a b = binOp Add a b (+.) a b = binOp Add a b instance (AdditiveBasisConstraints (A.Array c s) Double) => - AdditiveModule (A.Array c s) (D (A.Array c s) Double) (Computation (A.Array c s) Double (D (A.Array c s) Double)) Double where + AdditiveModule (A.Array c s) (D sc (A.Array c s) Double) (Computation sc Double (D sc (A.Array c s) Double)) Double where (.+) a b = do cb <- b binOp Add a cb @@ -398,12 +409,12 @@ instance (AdditiveBasisConstraints (A.Array c s) Double) => binOp Add a cb instance (AdditiveBasisConstraints (A.Array c s) Float) => - AdditiveModule (A.Array c s) (D (A.Array c s) Float) (D (A.Array c s) Float) Float where + AdditiveModule (A.Array c s) (D sc (A.Array c s) Float) (D sc (A.Array c s) Float) Float where (.+) a b = binOp Add a b (+.) a b = binOp Add a b instance (AdditiveBasisConstraints (A.Array c s) Float) => - AdditiveModule (A.Array c s) (D (A.Array c s) Float) (Computation (A.Array c s) Float (D (A.Array c s) Float)) Float where + AdditiveModule (A.Array c s) (D sc (A.Array c s) Float) (Computation sc Float (D sc (A.Array c s) Float)) Float where (.+) a b = do cb <- b binOp Add a cb @@ -412,7 +423,7 @@ instance (AdditiveBasisConstraints (A.Array c s) Float) => binOp Add a cb instance (AdditiveBasisConstraints (A.Array c s) Float) => - AdditiveModule (A.Array c s) (Computation (A.Array c s) Float (D (A.Array c s) Float)) (D (A.Array c s) Float) Float where + AdditiveModule (A.Array c s) (Computation sc Float (D sc (A.Array c s) Float)) (D sc (A.Array c s) Float) Float where (.+) a b = do ca <- a binOp Add ca b @@ -421,7 +432,7 @@ instance (AdditiveBasisConstraints (A.Array c s) Float) => binOp Add ca b instance (AdditiveBasisConstraints (A.Array c s) Float) => - AdditiveModule (A.Array c s) (Computation (A.Array c s) Float (D (A.Array c s) Float)) (Computation (A.Array c s) Float (D (A.Array c s) Float)) Float where + AdditiveModule (A.Array c s) (Computation sc Float (D sc (A.Array c s) Float)) (Computation sc Float (D sc (A.Array c s) Float)) Float where (.+) a b = do ca <- a cb <- b @@ -439,13 +450,13 @@ instance (AdditiveBasisConstraints (A.Array c s) Float) => class (AdditiveGroup a b r t) => AdditiveGroupModule r a b t where infixl 6 .- - (.-) :: a -> b -> Computation r t (D r t) + (.-) :: a -> b -> Computation (GetScope b) t (D (GetScope a) r t) infixl 6 -. - (-.) :: a -> b -> Computation r t (D r t) + (-.) :: a -> b -> Computation (GetScope b) t (D (GetScope a) r t) instance (AdditiveBasisConstraints (A.Array c s) Float) => - AdditiveGroupModule (A.Array c s) (D (A.Array c s) Float) (D (A.Array c s) Float) Float where + AdditiveGroupModule (A.Array c s) (D sc (A.Array c s) Float) (D sc (A.Array c s) Float) Float where (.-) a b = do cb <- (negate b) binOp Add a cb @@ -454,7 +465,7 @@ instance (AdditiveBasisConstraints (A.Array c s) Float) => binOp Add a cb instance (AdditiveBasisConstraints (A.Array c s) Float) => - AdditiveGroupModule (A.Array c s) (D (A.Array c s) Float) (Computation (A.Array c s) Float (D (A.Array c s) Float)) Float where + AdditiveGroupModule (A.Array c s) (D sc (A.Array c s) Float) (Computation sc Float (D sc (A.Array c s) Float)) Float where (.-) a b = do cb <- negate b binOp Add a cb @@ -463,7 +474,7 @@ instance (AdditiveBasisConstraints (A.Array c s) Float) => binOp Add a cb instance (AdditiveBasisConstraints (A.Array c s) Float) => - AdditiveGroupModule (A.Array c s) (Computation (A.Array c s) Float (D (A.Array c s) Float)) (D (A.Array c s) Float) Float where + AdditiveGroupModule (A.Array c s) (Computation sc Float (D sc (A.Array c s) Float)) (D sc (A.Array c s) Float) Float where (.-) a b = do ca <- a cb <- negate b @@ -474,7 +485,7 @@ instance (AdditiveBasisConstraints (A.Array c s) Float) => binOp Add ca cb instance (AdditiveBasisConstraints (A.Array c s) Float) => - AdditiveGroupModule (A.Array c s) (Computation (A.Array c s) Float (D (A.Array c s) Float)) (Computation (A.Array c s) Float (D (A.Array c s) Float)) Float where + AdditiveGroupModule (A.Array c s) (Computation sc Float (D sc (A.Array c s) Float)) (Computation sc Float (D sc (A.Array c s) Float)) Float where (.-) a b = do ca <- a cb <- negate b @@ -487,7 +498,7 @@ instance (AdditiveBasisConstraints (A.Array c s) Float) => instance (AdditiveBasisConstraints (A.Array c s) Double) => - AdditiveGroupModule (A.Array c s) (D (A.Array c s) Double) (D (A.Array c s) Double) Double where + AdditiveGroupModule (A.Array c s) (D sc (A.Array c s) Double) (D sc (A.Array c s) Double) Double where (.-) a b = do cb <- (negate b) binOp Add a cb @@ -496,7 +507,7 @@ instance (AdditiveBasisConstraints (A.Array c s) Double) => binOp Add a cb instance (AdditiveBasisConstraints (A.Array c s) Double) => - AdditiveGroupModule (A.Array c s) (D (A.Array c s) Double) (Computation (A.Array c s) Double (D (A.Array c s) Double)) Double where + AdditiveGroupModule (A.Array c s) (D sc (A.Array c s) Double) (Computation sc Double (D sc (A.Array c s) Double)) Double where (.-) a b = do cb <- negate b binOp Add a cb @@ -505,7 +516,7 @@ instance (AdditiveBasisConstraints (A.Array c s) Double) => binOp Add a cb instance (AdditiveBasisConstraints (A.Array c s) Double) => - AdditiveGroupModule (A.Array c s) (Computation (A.Array c s) Double (D (A.Array c s) Double)) (D (A.Array c s) Double) Double where + AdditiveGroupModule (A.Array c s) (Computation sc Double (D sc (A.Array c s) Double)) (D sc (A.Array c s) Double) Double where (.-) a b = do ca <- a cb <- negate b @@ -516,7 +527,7 @@ instance (AdditiveBasisConstraints (A.Array c s) Double) => binOp Add ca cb instance (AdditiveBasisConstraints (A.Array c s) Double) => - AdditiveGroupModule (A.Array c s) (Computation (A.Array c s) Double (D (A.Array c s) Double)) (Computation (A.Array c s) Double (D (A.Array c s) Double)) Double where + AdditiveGroupModule (A.Array c s) (Computation sc Double (D sc (A.Array c s) Double)) (Computation sc Double (D sc (A.Array c s) Double)) Double where (.-) a b = do ca <- a cb <- negate b @@ -535,30 +546,30 @@ instance (AdditiveBasisConstraints (A.Array c s) Double) => class (Additive a b r t) => AdditiveBasis r a b t where infixl 7 .+. - (.+.) :: a -> b -> Computation r t (D r t) + (.+.) :: a -> b -> Computation (GetScope b) t (D (GetScope a) r t) instance (AdditiveBasisConstraints (A.Array c s) Double) => - AdditiveBasis (A.Array c s) (D (A.Array c s) Double) (D (A.Array c s) Double) Double where + AdditiveBasis (A.Array c s) (D sc (A.Array c s) Double) (D sc (A.Array c s) Double) Double where (.+.) a b = binOp Add a b instance (AdditiveBasisConstraints (A.Array c s) Double) => - AdditiveBasis (A.Array c s) (D (A.Array c s) Double) (Computation (A.Array c s) Double (D (A.Array c s) Double)) Double where + AdditiveBasis (A.Array c s) (D sc (A.Array c s) Double) (Computation sc Double (D sc (A.Array c s) Double)) Double where (.+.) a b = do cb <- b binOp Add a cb instance (AdditiveBasisConstraints (A.Array c s) Double) => - AdditiveBasis (A.Array c s) (Computation (A.Array c s) Double (D (A.Array c s) Double)) (D (A.Array c s) Double) Double where + AdditiveBasis (A.Array c s) (Computation sc Double (D sc (A.Array c s) Double)) (D sc (A.Array c s) Double) Double where (.+.) a b = do ca <- a binOp Add ca b instance (AdditiveBasisConstraints (A.Array c s) Double) => - AdditiveBasis (A.Array c s) (Computation (A.Array c s) Double (D (A.Array c s) Double)) (Computation (A.Array c s) Double (D (A.Array c s) Double)) Double where + AdditiveBasis (A.Array c s) (Computation sc Double (D sc (A.Array c s) Double)) (Computation sc Double (D sc (A.Array c s) Double)) Double where (.+.) a b = do ca <- a cb <- b @@ -566,27 +577,27 @@ instance (AdditiveBasisConstraints (A.Array c s) Double) => instance (AdditiveBasisConstraints (A.Array c s) Float) => - AdditiveBasis (A.Array c s) (D (A.Array c s) Float) (D (A.Array c s) Float) Float where + AdditiveBasis (A.Array c s) (D sc (A.Array c s) Float) (D sc (A.Array c s) Float) Float where (.+.) a b = binOp Add a b instance (AdditiveBasisConstraints (A.Array c s) Float) => - AdditiveBasis (A.Array c s) (D (A.Array c s) Float) (Computation (A.Array c s) Float (D (A.Array c s) Float)) Float where + AdditiveBasis (A.Array c s) (D sc (A.Array c s) Float) (Computation sc Float (D sc (A.Array c s) Float)) Float where (.+.) a b = do cb <- b binOp Add a cb instance (AdditiveBasisConstraints (A.Array c s) Float) => - AdditiveBasis (A.Array c s) (Computation (A.Array c s) Float (D (A.Array c s) Float)) (D (A.Array c s) Float) Float where + AdditiveBasis (A.Array c s) (Computation sc Float (D sc (A.Array c s) Float)) (D sc (A.Array c s) Float) Float where (.+.) a b = do ca <- a binOp Add ca b instance (AdditiveBasisConstraints (A.Array c s) Float) => - AdditiveBasis (A.Array c s) (Computation (A.Array c s) Float (D (A.Array c s) Float)) (Computation (A.Array c s) Float (D (A.Array c s) Float)) Float where + AdditiveBasis (A.Array c s) (Computation sc Float (D sc (A.Array c s) Float)) (Computation sc Float (D sc (A.Array c s) Float)) Float where (.+.) a b = do ca <- a cb <- b @@ -600,24 +611,24 @@ instance (AdditiveBasisConstraints (A.Array c s) Float) => class (AdditiveGroup a b r t ) => AdditiveGroupBasis r a b t where infixl 6 .-. - (.-.) :: a -> b -> Computation r t (D r t) + (.-.) :: a -> b -> Computation (GetScope b) t (D (GetScope a) r t) instance (AdditiveBasisConstraints (A.Array c s) Float) => - AdditiveGroupBasis (A.Array c s) (D (A.Array c s) Float) (D (A.Array c s) Float) Float where + AdditiveGroupBasis (A.Array c s) (D sc (A.Array c s) Float) (D sc (A.Array c s) Float) Float where (.-.) a b = do cb <- negate b binOp Add a cb instance (AdditiveBasisConstraints (A.Array c s) Float) => - AdditiveGroupBasis (A.Array c s) (D (A.Array c s) Float) (Computation (A.Array c s) Float (D (A.Array c s) Float)) Float where + AdditiveGroupBasis (A.Array c s) (D sc (A.Array c s) Float) (Computation sc Float (D sc (A.Array c s) Float)) Float where (.-.) a b = do cb <- negate b binOp Add a cb instance (AdditiveBasisConstraints (A.Array c s) Float) => - AdditiveGroupBasis (A.Array c s) (Computation (A.Array c s) Float (D (A.Array c s) Float)) (D (A.Array c s) Float) Float where + AdditiveGroupBasis (A.Array c s) (Computation sc Float (D sc (A.Array c s) Float)) (D sc (A.Array c s) Float) Float where (.-.) a b = do ca <- a cb <- negate b @@ -625,7 +636,7 @@ instance (AdditiveBasisConstraints (A.Array c s) Float) => instance (AdditiveBasisConstraints (A.Array c s) Float) => - AdditiveGroupBasis (A.Array c s) (Computation (A.Array c s) Float (D (A.Array c s) Float)) (Computation (A.Array c s) Float (D (A.Array c s) Float)) Float where + AdditiveGroupBasis (A.Array c s) (Computation sc Float (D sc (A.Array c s) Float)) (Computation sc Float (D sc (A.Array c s) Float)) Float where (.-.) a b = do ca <- a cb <- negate b @@ -633,21 +644,21 @@ instance (AdditiveBasisConstraints (A.Array c s) Float) => instance (AdditiveBasisConstraints (A.Array c s) Double) => - AdditiveGroupBasis (A.Array c s) (D (A.Array c s) Double) (D (A.Array c s) Double) Double where + AdditiveGroupBasis (A.Array c s) (D sc (A.Array c s) Double) (D sc (A.Array c s) Double) Double where (.-.) a b = do cb <- negate b binOp Add a cb instance (AdditiveBasisConstraints (A.Array c s) Double) => - AdditiveGroupBasis (A.Array c s) (D (A.Array c s) Double) (Computation (A.Array c s) Double (D (A.Array c s) Double)) Double where + AdditiveGroupBasis (A.Array c s) (D sc (A.Array c s) Double) (Computation sc Double (D sc (A.Array c s) Double)) Double where (.-.) a b = do cb <- negate b binOp Add a cb instance (AdditiveBasisConstraints (A.Array c s) Double) => - AdditiveGroupBasis (A.Array c s) (Computation (A.Array c s) Double (D (A.Array c s) Double)) (D (A.Array c s) Double) Double where + AdditiveGroupBasis (A.Array c s) (Computation sc Double (D sc (A.Array c s) Double)) (D sc (A.Array c s) Double) Double where (.-.) a b = do ca <- a cb <- negate b @@ -655,7 +666,7 @@ instance (AdditiveBasisConstraints (A.Array c s) Double) => instance (AdditiveBasisConstraints (A.Array c s) Double) => - AdditiveGroupBasis (A.Array c s) (Computation (A.Array c s) Double (D (A.Array c s) Double)) (Computation (A.Array c s) Double (D (A.Array c s) Double)) Double where + AdditiveGroupBasis (A.Array c s) (Computation sc Double (D sc (A.Array c s) Double)) (Computation sc Double (D sc (A.Array c s) Double)) Double where (.-.) a b = do ca <- a cb <- negate b diff --git a/src/Internal/NumHask/Prelude.hs b/src/Internal/NumHask/Prelude.hs index 7fd712b..a31fcdc 100644 --- a/src/Internal/NumHask/Prelude.hs +++ b/src/Internal/NumHask/Prelude.hs @@ -9,17 +9,17 @@ module Internal.NumHask.Prelude -- * Algebraic Heirarchy -- $instances , module Internal.NumHask.Algebra.Additive - -- , module Internal.NumHask.Algebra.Basis - , module Internal.NumHask.Algebra.Distribution - , module Internal.NumHask.Algebra.Field - -- , module NumHask.Algebra.Integral - , module Internal.NumHask.Algebra.Magma - , module Internal.NumHask.Algebra.Metric - , module Internal.NumHask.Algebra.Module - , module Internal.NumHask.Algebra.Multiplicative - , module Internal.NumHask.Algebra.Ring - , module Internal.NumHask.Algebra.Singleton - -- , module Internal.NumHask.Algebra.Diff + + -- , module Internal.NumHask.Algebra.Distribution + -- , module Internal.NumHask.Algebra.Field + + -- , module Internal.NumHask.Algebra.Magma + -- , module Internal.NumHask.Algebra.Metric + -- , module Internal.NumHask.Algebra.Module + -- , module Internal.NumHask.Algebra.Multiplicative + -- , module Internal.NumHask.Algebra.Ring + -- , module Internal.NumHask.Algebra.Singleton + ) where @@ -32,17 +32,17 @@ import Protolude zero) import Internal.NumHask.Algebra.Additive --- import Internal.NumHask.Algebra.Basis -import Internal.NumHask.Algebra.Distribution -import Internal.NumHask.Algebra.Field --- import NumHask.Algebra.Integral -import Internal.NumHask.Algebra.Magma -import Internal.NumHask.Algebra.Metric -import Internal.NumHask.Algebra.Module -import Internal.NumHask.Algebra.Multiplicative -import Internal.NumHask.Algebra.Ring -import Internal.NumHask.Algebra.Singleton --- import Internal.NumHask.Algebra.Diff + +-- import Internal.NumHask.Algebra.Distribution +-- import Internal.NumHask.Algebra.Field + +-- import Internal.NumHask.Algebra.Magma +-- import Internal.NumHask.Algebra.Metric +-- import Internal.NumHask.Algebra.Module +-- import Internal.NumHask.Algebra.Multiplicative +-- import Internal.NumHask.Algebra.Ring +-- import Internal.NumHask.Algebra.Singleton + -- $backend -- NumHask imports Protolude as the prelude and replaces much of the 'Num' heirarchy in base. diff --git a/stack.yaml b/stack.yaml index df549f7..509094f 100644 --- a/stack.yaml +++ b/stack.yaml @@ -6,10 +6,21 @@ packages: git: https://github.com/o1lo01ol1o/numhask-array commit: b5c745d24630dfff294d37d1ed93352f724c5792 extra-dep: true +- location: + git: https://github.com/atzeus/HMap + commit: 218519a583e1849c23e0bb476e2245018f9bb8f7 + extra-dep: true extra-deps: - dimensions-0.3.2.0 - tasty-0.12 - value-supply-0.6 +- data-variant-0.28.0.5 +- heterolist-0.2.0.0 +- constraint-manip-0.1.1.0 +- indextype-0.2.3.0 +- polydata-0.1.0.0 + + resolver: lts-10.4 allow-newer: true diff --git a/test/.#Spec.hs b/test/.#Spec.hs deleted file mode 120000 index f858ff5..0000000 --- a/test/.#Spec.hs +++ /dev/null @@ -1 +0,0 @@ -timpierson@Tims-MBP-2.lan.16551 \ No newline at end of file