DeepDarkFantasy 0.2017.8.16 → 0.2017.8.17

raw patch · 4 files changed

+103/−18 lines, 4 filesPVP: minor bump suggested

API additions: PVP suggests at least a minor version bump

API changes (from Hackage documentation)

Files

• DDF/DBI.hs +3/−0
• DDF/Dual.hs +1/−0
• DDF/PE.hs +98/−17
• DeepDarkFantasy.cabal +1/−1

@@ -74,6 +74,9 @@ class Functor r a => Applicative r a where
   pure :: r h (x -> a x)
   ap :: r h (a (x -> y) -> a x -> a y)
+pure1 = app1 pure
+ap1 = app1 ap
+ap2 = app2 ap
 
 class Applicative r m => Monad r m where
   bind :: r h (m a -> (a -> m b) -> m b)

@@ -22,3 +22,4 @@ mkDual2 = app2 mkDual dualOrig1 = app dualOrig dualDiff1 = app dualDiff+runDual1 = app1 runDual

@@ -11,13 +11,15 @@   FlexibleContexts,   KindSignatures,   TypeFamilies,-  TypeApplications+  TypeApplications,+  MultiParamTypeClasses #-}  module DDF.PE where  import DDF.Lang import qualified Prelude as M+import qualified DDF.Meta.Dual as M  data P repr h a where   Open   :: (forall hout. EnvT repr h hout -> P repr hout a) -> P repr h a@@ -90,7 +92,7 @@     f Weak             = s (s p)    abs (Unk f) = Unk (abs f)-  abs o@(Open _) = mkFun (app_open o)+  abs (Open o) = mkFun o   abs (Known _ _ _ _ x) = x    app (Known (Fun fs) _ _ _ _) p     = fs (Arg p)@@ -105,8 +107,8 @@       f :: P r h M.Bool -> P r h (a -> a -> a)       f (Known M.True _ _ _ _) = const       f (Known M.False _ _ _ _) = const1 id+      f (Open x) = Open $ f . x       f (Unk x) = Unk (lam2 (\l r -> ite3 l r (s (s x))))-      f x@(Open _) = Open (\h -> f (app_open x h))  type instance K repr h M.Double = M.Double instance Double r => Double (P r) where@@ -135,7 +137,7 @@       f (Known l _ _ _ _) (Known r _ _ _ _) = double (l - r)       f l (Known 0 _ _ _ _) = l        f l r | isOpen l || isOpen r = Open (\h -> f (app_open l h) (app_open r h))-      f l r = Unk (doubleMinus2 (dynamic l) (dynamic r))+      f l r = Unk $ doubleMinus2 (dynamic l) (dynamic r)   doubleDivide = abs (abs (f (s z) z))     where       f :: P r h M.Double -> P r h M.Double -> P r h M.Double@@ -143,13 +145,13 @@       f (Known 0 _ _ _ _) _ = double 0       f l (Known 1 _ _ _ _) = l        f l r | isOpen l || isOpen r = Open (\h -> f (app_open l h) (app_open r h))-      f l r = Unk (doubleDivide2 (dynamic l) (dynamic r))+      f l r = Unk $ doubleDivide2 (dynamic l) (dynamic r)   doubleExp = abs (f z)     where       f :: P r h M.Double -> P r h M.Double       f (Known l _ _ _ _) = double (M.exp l) -      f (Unk l) = Unk (doubleExp1 l)-      f l@(Open _) = Open (\h -> f (app_open l h))+      f (Open x) = Open $ f . x+      f (Unk l) = Unk $ doubleExp1 l   doubleEq = abs (abs (f (s z) z)) where     f :: P r h M.Double -> P r h M.Double -> P r h M.Bool     f (Known l _ _ _ _) (Known r _ _ _ _) = bool (l == r)@@ -196,8 +198,8 @@     where       f :: P r h M.Float -> P r h M.Float       f (Known l _ _ _ _) = float (M.exp l) +      f (Open x) = Open $ f . x       f (Unk l) = Unk (floatExp1 l)-      f l@(Open _) = Open (\h -> f (app_open l h))  type instance K repr h (a, b) = (P repr h a, P repr h b) instance Prod r => Prod (P r) where@@ -207,19 +209,19 @@       f l r = know (l, r)                 (mkProd2 (dynamic l) (dynamic r))                 (\h -> mkProd2 (app_open l h) (app_open r h))-                (s (mkProd2 l r))+                (mkProd2 (s l) (s r))   zro = abs (f z)     where       f :: P r h (a, b) -> P r h a       f (Known (l, _) _ _ _ _) = l+      f (Open x) = Open $ f . x       f (Unk p) = Unk (zro1 p)-      f p = Open (\h -> f (app_open p h))   fst = abs (f z)     where       f :: P r h (a, b) -> P r h b       f (Known (_, r) _ _ _ _) = r+      f (Open x) = Open $ f . x       f (Unk p) = Unk (fst1 p)-      f p = Open (\h -> f (app_open p h))  type instance K repr h (M.Either a b) = M.Either (P repr h a) (P repr h b) instance Sum r => Sum (P r) where@@ -229,21 +231,21 @@       f x = know (Left x)               (left1 $ dynamic x)               (\h -> left1 $ app_open x h)-              (s $ left1 x)+              (left1 $ s x)   right = abs (f z)     where       f :: P r h b -> P r h (M.Either a b)       f x = know (Right x)               (right1 $ dynamic x)               (\h -> right1 $ app_open x h)-              (s $ right1 x)+              (right1 $ s x)   sumMatch = abs $ abs $ abs (f (s (s z)) (s z) z)     where       f :: P r h (a -> c) -> P r h (b -> c) -> P r h (M.Either a b) -> P r h c       f l _ (Known (M.Left x) _ _ _ _) = app l x       f _ r (Known (M.Right x) _ _ _ _) = app r x-      f l r (Unk x) = Unk $ sumMatch3 (dynamic l) (dynamic r) x       f l r (Open x) = Open $ \h -> f (app_open l h) (app_open r h) (x h)+      f l r (Unk x) = Unk $ sumMatch3 (dynamic l) (dynamic r) x  instance Y r => Y (P r) where   y = Unk y -- naive strategy to avoid infinite loop in PE. Later might do infinite PE thx to laziness.@@ -257,14 +259,14 @@       f h t = know (Just (h, t))                 (cons2 (dynamic h) (dynamic t))                 (\env -> cons2 (app_open h env) (app_open t env))-                (s $ cons2 h t)+                (cons2 (s h) (s t))   listMatch = abs $ abs $ abs (f (s $ s z) (s z) z)     where       f :: P repr h b -> P repr h (a -> [a] -> b) -> P repr h [a] -> P repr h b       f l _ (Known Nothing _ _ _ _) = l -- You know nothing, Jon Snow.       f _ r (Known (Just (h, t)) _ _ _ _) = app2 r h t-      f l r (Unk x) = Unk $ listMatch3 (dynamic l) (dynamic r) x       f l r (Open x) = Open $ \h -> f (app_open l h) (app_open r h) (x h)+      f l r (Unk x) = Unk $ listMatch3 (dynamic l) (dynamic r) x   listAppend = abs $ abs (f (s z) z)     where       f :: P repr h [a] -> P repr h [a] -> P repr h [a]@@ -289,8 +291,87 @@       f :: P repr h b -> P repr h (a -> b) -> P repr h (Maybe a) -> P repr h b       f l _ (Known Nothing _ _ _ _) = l       f _ r (Known (Just x) _ _ _ _) = app r x-      f l r (Unk x) = Unk $ optionMatch3 (dynamic l) (dynamic r) x       f l r (Open x) = Open $ \h -> f (app_open l h) (app_open r h) (x h)+      f l r (Unk x) = Unk $ optionMatch3 (dynamic l) (dynamic r) x++type instance K repr h M.Char = M.Char+instance Char repr => Char (P repr) where+  char x = static (x, char x)++type instance K repr h M.Int = M.Int+instance Int repr => Int (P repr) where+  int x = static (x, int x)+  pred = abs (f z)+    where+      f :: P repr h M.Int -> P repr h M.Int+      f (Known i _ _ _ _) = int $ i - 1+      f (Open x) = Open $ f . x+      f (Unk x) = Unk $ pred1 x+  isZero = abs (f z)+    where+      f :: P repr h M.Int -> P repr h M.Bool+      f (Known i _ _ _ _) = bool $ i == 0+      f (Open x) = Open $ f . x+      f (Unk x) = Unk $ isZero1 x++type instance K repr h (M.Dual l r) = (P repr h l, P repr h r)+instance Dual repr => Dual (P repr) where+  dual = abs (f z)+    where+      f :: P repr h (a, b) -> P repr h (M.Dual a b)+      f (Known (l, r) _ _ _ _) =+        know (l, r)+          (mkDual2 (dynamic l) (dynamic r))+          (\h -> mkDual2 (app_open l h) (app_open r h))+          (s $ mkDual2 l r)+      f (Open x) = Open $ f . x+      f (Unk x) = Unk $ dual1 x+  runDual = abs (f z)+    where+      f :: P repr h (M.Dual a b) -> P repr h (a, b)+      f (Known (l, r) _ _ _ _) =+        know (l, r)+          (mkProd2 (dynamic l) (dynamic r))+          (\h -> mkProd2 (app_open l h) (app_open r h))+          (mkProd2 (s l) (s r))+      f (Open x) = Open $ f . x+      f (Unk x) = Unk $ runDual1 x++type instance K repr h () = ()+instance Unit repr => Unit (P repr) where+  unit = static ((), unit)++type instance K repr h (M.IO a) = P repr h a+instance IO repr => Functor (P repr) M.IO where+  map = abs $ abs (f (s z) z)+    where+      f :: P repr h (a -> b) -> P repr h (M.IO a) -> P repr h (M.IO b)+      f l (Known a _ _ _ _) = pure1 $ app l a+      f l (Open x) = Open $ \h -> f (app_open l h) (x h)+      f l (Unk x) = Unk $ map2 (dynamic l) x++instance IO repr => Applicative (P repr) M.IO where+  pure = abs $ f z+    where+      f :: P repr h a -> P repr h (M.IO a)+      f x = know x (pure1 $ dynamic x) (\h -> pure1 $ app_open x h) (pure1 $ s x)+  ap = abs $ abs $ f (s z) z+    where+      f :: P repr h (M.IO (a -> b)) -> P repr h (M.IO a) -> P repr h (M.IO b)+      f (Known l _ _ _ _) (Known r _ _ _ _) = pure1 $ app l r+      f l r | isOpen l || isOpen r = Open $ \h -> f (app_open l h) (app_open r h)+      f l r = Unk $ ap2 (dynamic l) (dynamic r)++instance IO repr => Monad (P repr) M.IO where+  join = abs $ f z+    where+      f :: P repr h (M.IO (M.IO a)) -> P repr h (M.IO a)+      f (Known l _ _ _ _) = l+      f (Open x) = Open $ f . x+      f (Unk x) = Unk $ join1 x++instance IO repr => IO (P repr) where+  putStrLn = Unk putStrLn  pe :: DBI repr => P repr () a -> repr () a pe = dynamic

@@ -1,5 +1,5 @@ name: DeepDarkFantasy-version: 0.2017.8.16+version: 0.2017.8.17 cabal-version: 1.12 build-type: Simple license: Apache