DeepDarkFantasy 0.2017.4.5 → 0.2017.4.9

raw patch · 12 files changed

+84/−46 lines, 12 filesdep +bimapPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: bimap

API changes (from Hackage documentation)

Files

• DDF/Bimap.hs +7/−0
• DDF/Combine.hs +9/−6
• DDF/DBI.hs +3/−0
• DDF/Eval.hs +8/−4
• DDF/GWDiff.hs +11/−8
• DDF/ImpW.hs +9/−6
• DDF/Lang.hs +5/−4
• DDF/Show.hs +4/−1
• DDF/Size.hs +4/−1
• DDF/UnHOAS.hs +9/−6
• DDF/WDiff.hs +11/−8
• DeepDarkFantasy.cabal +4/−2

@@ -0,0 +1,7 @@+module DDF.Bimap (module DDF.Bimap, module DDF.Prod, module DDF.Option) where++import DDF.Map as Map+import DDF.Prod+import DDF.Option++class Map.Map r => Bimap r where

@@ -3,6 +3,7 @@ module DDF.Combine where  import DDF.Lang+import qualified DDF.Map as Map  data Combine l r h x = Combine (l h x) (r h x) @@ -46,12 +47,14 @@   just = Combine just just   optionMatch = Combine optionMatch optionMatch -instance (Map l, Map r) => Map (Combine l r) where-  empty = Combine empty empty-  lookup = Combine lookup lookup-  singleton = Combine singleton singleton-  alter = Combine alter alter-  mapMap = Combine mapMap mapMap+instance (Map.Map l, Map.Map r) => Map.Map (Combine l r) where+  empty = Combine Map.empty Map.empty+  lookup = Combine Map.lookup Map.lookup+  singleton = Combine Map.singleton Map.singleton+  alter = Combine Map.alter Map.alter+  mapMap = Combine Map.mapMap Map.mapMap++instance (Bimap l, Bimap r) => Bimap (Combine l r) where  instance (Dual l, Dual r) => Dual (Combine l r) where   dual = Combine dual dual

@@ -37,6 +37,9 @@   s :: repr h b -> repr (a, h) b
   abs :: repr (a, h) b -> repr h (a -> b)
   app :: repr h (a -> b) -> repr h a -> repr h b
+  -- | We use a variant of HOAS so it can be compile to DBI, which is more compositional (No Negative Occurence).
+  -- It require explicit lifting of variables.
+  -- Use lam to do automatic lifting of variables.
   hoas :: (repr (a, h) a -> repr (a, h) b) -> repr h (a -> b)
   hoas f = abs $ f z
   com :: repr h ((b -> c) -> (a -> b) -> (a -> c))

@@ -1,6 +1,7 @@--{-# LANGUAGE NoImplicitPrelude,-  LambdaCase #-}+{-# LANGUAGE+  NoImplicitPrelude,+  LambdaCase+#-}  module DDF.Eval where @@ -14,6 +15,7 @@ import qualified Data.Bool as M import qualified Data.Map as M.Map import qualified DDF.Meta.Dual as M+import qualified DDF.Map as Map  newtype Eval h x = Eval {runEval :: h -> x} @@ -60,12 +62,14 @@                               M.Nothing -> l                               M.Just x -> r x -instance Map Eval where+instance Map.Map Eval where   empty = comb M.Map.empty   singleton = comb M.Map.singleton   lookup = comb M.Map.lookup   alter = comb M.Map.alter   mapMap = comb M.fmap++instance Bimap Eval where  instance Dual Eval where   dual = comb M.Dual

@@ -10,6 +10,7 @@ import qualified Prelude as M import DDF.Diff import qualified Data.Map as M+import qualified DDF.Map as Map  newtype GWDiff r h x = GWDiff {runGWDiff :: forall v. Vector r v => Proxy v -> r (Diff v h) (Diff v x)} @@ -70,14 +71,16 @@   just = GWDiff $ M.const just   optionMatch = GWDiff $ M.const optionMatch -instance Map r => Map (GWDiff r) where-  empty = GWDiff $ M.const empty-  singleton = GWDiff $ M.const singleton-  lookup :: forall h k a. Ord k => GWDiff r h (k -> M.Map k a -> Maybe a)-  lookup = GWDiff $ \(_ :: Proxy v) -> withDict (diffOrd (Proxy :: Proxy (v, k))) lookup-  alter :: forall h k a. Ord k => GWDiff r h ((Maybe a -> Maybe a) -> k -> M.Map k a -> M.Map k a)-  alter = GWDiff $ \(_ :: Proxy v) -> withDict (diffOrd (Proxy :: Proxy (v, k))) alter-  mapMap = GWDiff $ M.const mapMap+instance Map.Map r => Map.Map (GWDiff r) where+  empty = GWDiff $ M.const Map.empty+  singleton = GWDiff $ M.const Map.singleton+  lookup :: forall h k a. Map.Ord k => GWDiff r h (k -> M.Map k a -> Maybe a)+  lookup = GWDiff $ \(_ :: Proxy v) -> withDict (Map.diffOrd (Proxy :: Proxy (v, k))) Map.lookup+  alter :: forall h k a. Map.Ord k => GWDiff r h ((Maybe a -> Maybe a) -> k -> M.Map k a -> M.Map k a)+  alter = GWDiff $ \(_ :: Proxy v) -> withDict (Map.diffOrd (Proxy :: Proxy (v, k))) Map.alter+  mapMap = GWDiff $ M.const Map.mapMap++instance Bimap r => Bimap (GWDiff r) where  instance Lang r => Lang (GWDiff r) where   fix = GWDiff $ M.const fix

@@ -3,6 +3,7 @@ module DDF.ImpW where  import DDF.Lang+import qualified DDF.Map as Map  data RunImpW repr h x = forall w. Weight w => RunImpW (repr h (w -> x)) data ImpW repr h x = NoImpW (repr h x) | forall w. Weight w => ImpW (repr h (w -> x))@@ -64,12 +65,14 @@   just = NoImpW just   optionMatch = NoImpW optionMatch -instance Map r => Map (ImpW r) where-  empty = NoImpW empty-  singleton = NoImpW singleton-  lookup = NoImpW lookup-  alter = NoImpW alter-  mapMap = NoImpW mapMap+instance Map.Map r => Map.Map (ImpW r) where+  empty = NoImpW Map.empty+  singleton = NoImpW Map.singleton+  lookup = NoImpW Map.lookup+  alter = NoImpW Map.alter+  mapMap = NoImpW Map.mapMap++instance Bimap r => Bimap (ImpW r) where  instance Dual r => Dual (ImpW r) where   dual = NoImpW dual

@@ -21,12 +21,12 @@     PartialTypeSignatures,     NoImplicitPrelude #-} -module DDF.Lang (module DDF.Lang, module DDF.Bool, module DDF.Char, module DDF.Double, module DDF.Float, module DDF.Map, module DDF.Dual) where+module DDF.Lang (module DDF.Lang, module DDF.Bool, module DDF.Char, module DDF.Double, module DDF.Float, module DDF.Bimap, module DDF.Dual) where import DDF.Bool import DDF.Char import DDF.Double import DDF.Float-import DDF.Map+import DDF.Bimap import DDF.Dual  import qualified DDF.Meta.Dual as M@@ -34,8 +34,9 @@ import qualified GHC.Float as M import qualified Prelude as M import qualified Data.Map as M+import qualified DDF.Map as Map -class (Bool r, Char r, Double r, Float r, Map r, Dual r) => Lang r where+class (Bool r, Char r, Double r, Float r, Bimap r, Dual r) => Lang r where   fix :: r h ((a -> a) -> a)   left :: r h (a -> M.Either a b)   right :: r h (b -> M.Either a b)@@ -170,7 +171,7 @@   map = lam $ \f -> com2 writer (com2 (bimap2 f id) runWriter)  instance Lang r => Functor r (M.Map k) where-  map = mapMap+  map = Map.mapMap  instance (Lang r, Monoid r w) => Applicative r (Writer w) where   pure = com2 writer (flip2 mkProd zero)

@@ -4,6 +4,7 @@  import DDF.Lang import qualified Prelude as M+import qualified DDF.Map as Map  data AST = Leaf M.String | App M.String AST [AST] | Lam M.String [M.String] AST @@ -63,12 +64,14 @@   just = name "just"   optionMatch = name "optionMatch" -instance Map Show where+instance Map.Map Show where   empty = name "empty"   singleton = name "singleton"   lookup = name "lookup"   alter = name "alter"   mapMap = name "mapMap"++instance Bimap Show where  instance Dual Show where   dual = name "dual"

@@ -3,6 +3,7 @@ module DDF.Size where  import DDF.Lang+import qualified DDF.Map as Map  newtype Size h x = Size {runSize :: Int} @@ -42,7 +43,7 @@   floatDivide = one   floatExp = one -instance Map Size where+instance Map.Map Size where   mapMap = one   alter = one   empty = one@@ -57,6 +58,8 @@ instance Dual Size where   dual = one   runDual = one++instance Bimap Size where  instance Lang Size where   fix = one

@@ -3,6 +3,7 @@ module DDF.UnHOAS where  import DDF.Lang+import qualified DDF.Map as Map  newtype UnHOAS repr h x = UnHOAS {runUnHOAS :: repr h x} @@ -45,12 +46,14 @@   just = UnHOAS just   optionMatch = UnHOAS optionMatch -instance Map r => Map (UnHOAS r) where-  empty = UnHOAS empty-  singleton = UnHOAS singleton-  alter = UnHOAS alter-  lookup = UnHOAS lookup-  mapMap = UnHOAS mapMap+instance Map.Map r => Map.Map (UnHOAS r) where+  empty = UnHOAS Map.empty+  singleton = UnHOAS Map.singleton+  alter = UnHOAS Map.alter+  lookup = UnHOAS Map.lookup+  mapMap = UnHOAS Map.mapMap++instance Bimap r => Bimap (UnHOAS r) where  instance Dual r => Dual (UnHOAS r) where   dual = UnHOAS dual

@@ -10,6 +10,7 @@ import DDF.Lang import DDF.Diff import qualified Data.Map as M+import qualified DDF.Map as Map  newtype WDiff r v h x = WDiff {runWDiff :: r (Diff v h) (Diff v x)} @@ -71,14 +72,16 @@   just = WDiff just   optionMatch = WDiff optionMatch -instance Map r => Map (WDiff r v) where-  empty = WDiff empty-  singleton = WDiff singleton-  lookup :: forall h k a. Ord k => WDiff r v h (k -> M.Map k a -> Maybe a)-  lookup = withDict (diffOrd (Proxy :: Proxy (v, k))) (WDiff lookup)-  alter :: forall h k a. Ord k => WDiff r v h ((Maybe a -> Maybe a) -> k -> M.Map k a -> M.Map k a)-  alter = withDict (diffOrd (Proxy :: Proxy (v, k))) (WDiff alter)-  mapMap = WDiff mapMap+instance Map.Map r => Map.Map (WDiff r v) where+  empty = WDiff Map.empty+  singleton = WDiff Map.singleton+  lookup :: forall h k a. Map.Ord k => WDiff r v h (k -> M.Map k a -> Maybe a)+  lookup = withDict (Map.diffOrd (Proxy :: Proxy (v, k))) (WDiff Map.lookup)+  alter :: forall h k a. Map.Ord k => WDiff r v h ((Maybe a -> Maybe a) -> k -> M.Map k a -> M.Map k a)+  alter = withDict (Map.diffOrd (Proxy :: Proxy (v, k))) (WDiff Map.alter)+  mapMap = WDiff Map.mapMap++instance Bimap r => Bimap (WDiff r v) where  instance (Vector r v, Lang r) => Lang (WDiff r v) where   fix = WDiff fix

@@ -1,5 +1,5 @@ name: DeepDarkFantasy-version: 0.2017.4.5+version: 0.2017.4.9 cabal-version: 1.12 build-type: Simple license: Apache@@ -16,6 +16,7 @@  library   exposed-modules:+    DDF.Bimap     DDF.Bool     DDF.Char     DDF.Combine@@ -46,7 +47,8 @@     mtl -any,     random -any,     constraints -any,-    containers -any+    containers -any,+    bimap -any   ghc-options: -Wall -Wno-type-defaults -Wno-missing-signatures -Wno-orphans -fwarn-tabs -ferror-spans   default-language: Haskell2010