DeepDarkFantasy 0.2017.8.17 → 0.2017.8.18
raw patch · 14 files changed
+125/−37 lines, 14 filesPVP: major bump suggested
API removals or changes: PVP suggests a major version bump
API changes (from Hackage documentation)
+ DDF.Bool: false :: Bool r => r h Bool
+ DDF.Bool: true :: Bool r => r h Bool
+ DDF.Diff: instance (DDF.Vector.Vector r v, DDF.Ordering.Ordering r) => DDF.Ordering.Ordering (DDF.Meta.Diff.Diff r v)
+ DDF.Eval: instance DDF.Ordering.Ordering DDF.Eval.Eval
+ DDF.ImpW: instance (DDF.Prod.Prod r, DDF.Ordering.Ordering r) => DDF.Ordering.Ordering (DDF.ImpW.ImpW r)
+ DDF.Ordering: class DBI repr => Ordering repr where ltOrd = ordering LT eqOrd = ordering EQ gtOrd = ordering GT
+ DDF.Ordering: eqOrd :: Ordering repr => repr h Ordering
+ DDF.Ordering: gtOrd :: Ordering repr => repr h Ordering
+ DDF.Ordering: isEQ :: (Bool r, Ordering r) => r h (Ordering -> Bool)
+ DDF.Ordering: isGT :: (Bool r, Ordering r) => r h (Ordering -> Bool)
+ DDF.Ordering: isLT :: (Bool r, Ordering r) => r h (Ordering -> Bool)
+ DDF.Ordering: ltOrd :: Ordering repr => repr h Ordering
+ DDF.Ordering: ordering :: Ordering repr => Ordering -> repr h Ordering
+ DDF.Ordering: sel :: Ordering repr => repr h (a -> a -> a -> Ordering -> a)
+ DDF.Ordering: sel1 :: Ordering r => r h a -> r h (a -> a -> Ordering -> a)
+ DDF.Ordering: sel2 :: Ordering r => r h a -> r h a -> r h (a -> Ordering -> a)
+ DDF.Ordering: sel3 :: Ordering r => r h a -> r h a -> r h a -> r h (Ordering -> a)
+ DDF.Ordering: sel4 :: Ordering r => r h b -> r h b -> r h b -> r h Ordering -> r h b
+ DDF.PE: [EmptyMap] :: MapPE repr h k a
+ DDF.PE: [SingletonMap] :: P repr h k -> P repr h a -> MapPE repr h k a
+ DDF.PE: data MapPE (repr :: * -> * -> *) h k a :: *
+ DDF.Show: instance DDF.Ordering.Ordering DDF.Show.Show
+ DDF.Size: instance DDF.Ordering.Ordering DDF.Size.Size
+ DDF.Term: instance DDF.TermGen.SubL DDF.Lang.Lang DDF.Ordering.Ordering
+ DDF.TermGen: instance DDF.TermGen.SubL c DDF.Ordering.Ordering => DDF.Ordering.Ordering (DDF.TermGen.Term c)
+ DDF.UnHOAS: instance DDF.Ordering.Ordering r => DDF.Ordering.Ordering (DDF.UnHOAS.UnHOAS r)
+ DDF.UnLiftEnv: instance (DDF.Prod.Prod r, DDF.Ordering.Ordering r) => DDF.Ordering.Ordering (DDF.UnLiftEnv.UnLiftEnv r)
- DDF.Bool: class DBI r => Bool r
+ DDF.Bool: class DBI r => Bool r where true = bool True false = bool False
- DDF.Lang: class (Bool r, Char r, Double r, Float r, Bimap r, Dual r, Unit r, Sum r, Int r, IO r, VectorTF r, DiffWrapper r, Fix r, FreeVector r) => Lang r where iterate = lam $ \ f -> y1 $ lam2 $ \ fi x -> cons2 x (app fi (app f x)) buildFreeVector = lam $ \ fb -> freeVector1 $ lam $ \ b -> optionMatch3 (double 0) id (lookup2 fb b) toSVTFBuilder = lam $ \ x -> state1 $ lam $ \ m -> optionMatch3 (let_2 (size1 m) (lam $ \ si -> mkProd2 si (insert2 (mkProd2 x si) m))) (lam $ \ xid -> mkProd2 xid m) (lookupL2 m x) get = optionMatch2 undefined id getVar = state1 (dup1 mkProd) update = lam $ \ f -> state1 $ lam $ \ x -> mkProd2 unit (app f x) updateWengert = lam2 $ \ i d -> alter2 (optionMatch2 (just1 d) (just `com2` (plus1 d))) i vtfCata = lam $ \ f -> y1 $ lam $ \ fx -> vtfMatch4 (app f zero) (f `com2` basis) (lam2 $ \ l r -> app f (plus2 (app fx l) (app fx r))) (lam2 $ \ d v -> app f (mult2 d (app fx v))) `com2` runFix
+ DDF.Lang: class (Ordering r, Char r, Double r, Float r, Bimap r, Dual r, Unit r, Sum r, Int r, IO r, VectorTF r, DiffWrapper r, Fix r, FreeVector r) => Lang r where iterate = lam $ \ f -> y1 $ lam2 $ \ fi x -> cons2 x (app fi (app f x)) buildFreeVector = lam $ \ fb -> freeVector1 $ lam $ \ b -> optionMatch3 (double 0) id (lookup2 fb b) toSVTFBuilder = lam $ \ x -> state1 $ lam $ \ m -> optionMatch3 (let_2 (size1 m) (lam $ \ si -> mkProd2 si (insert2 (mkProd2 x si) m))) (lam $ \ xid -> mkProd2 xid m) (lookupL2 m x) get = optionMatch2 undefined id getVar = state1 (dup1 mkProd) update = lam $ \ f -> state1 $ lam $ \ x -> mkProd2 unit (app f x) updateWengert = lam2 $ \ i d -> alter2 (optionMatch2 (just1 d) (just `com2` (plus1 d))) i vtfCata = lam $ \ f -> y1 $ lam $ \ fx -> vtfMatch4 (app f zero) (f `com2` basis) (lam2 $ \ l r -> app f (plus2 (app fx l) (app fx r))) (lam2 $ \ d v -> app f (mult2 d (app fx v))) `com2` runFix
Files
- DDF/Bool.hs +4/−0
- DDF/Diff.hs +5/−0
- DDF/Eval.hs +8/−1
- DDF/ImpW.hs +4/−0
- DDF/ImportMeta.hs +2/−1
- DDF/Lang.hs +5/−3
- DDF/Ordering.hs +26/−0
- DDF/PE.hs +23/−0
- DDF/Show.hs +4/−0
- DDF/Size.hs +4/−0
- DDF/TermGen.hs +30/−31
- DDF/UnHOAS.hs +4/−0
- DDF/UnLiftEnv.hs +4/−0
- DeepDarkFantasy.cabal +2/−1
DDF/Bool.hs view
@@ -6,6 +6,10 @@ class DBI r => Bool r where bool :: M.Bool -> r h M.Bool+ true :: r h M.Bool+ true = bool M.True+ false :: r h M.Bool+ false = bool M.False ite :: r h (a -> a -> M.Bool -> a) ite1 = app ite
DDF/Diff.hs view
@@ -209,3 +209,8 @@ instance Map.Ord M.Float where diffOrd _ = Dict++type instance DiffType v M.Ordering = M.Ordering+instance (Vector r v, Ordering r) => Ordering (Diff r v) where+ ordering = Diff . ordering+ sel = Diff sel
DDF/Eval.hs view
@@ -26,6 +26,8 @@ import qualified DDF.Meta.FreeVector as M import DDF.Lang +newtype Eval h x = Eval {runEval :: h -> x}+ comb = Eval . M.const instance DBI Eval where@@ -166,4 +168,9 @@ state = comb M.state runState = comb M.runState -newtype Eval h x = Eval {runEval :: h -> x}+instance Ordering Eval where+ ordering = comb+ sel = comb f where+ f x _ _ M.LT = x+ f _ x _ M.EQ = x+ f _ _ x M.GT = x
DDF/ImpW.hs view
@@ -187,6 +187,10 @@ freeVector = NoImpW freeVector runFreeVector = NoImpW runFreeVector +instance (Prod r, Ordering r) => Ordering (ImpW r) where+ sel = NoImpW sel+ ordering = NoImpW . ordering+ instance Lang r => Lang (ImpW r) where exfalso = NoImpW exfalso writer = NoImpW writer
DDF/ImportMeta.hs view
@@ -10,7 +10,8 @@ module Data.Proxy, module DDF.Util) where -import Prelude (($), show, (+), (-), (*), (/), (.), (++), (>>=), (<=), (<), (==), compare, print, Maybe(Just, Nothing), String, (||), Either(Left, Right))+import Prelude (+ ($), show, (+), (-), (*), (/), (.), (++), (>>=), (<=), (<), (==), compare, print, Maybe(Just, Nothing), String, (||), Either(Left, Right)) import Data.Void (Void, absurd) import Control.Monad.Writer (Writer) import Control.Monad.State (State)
DDF/Lang.hs view
@@ -9,13 +9,14 @@ module DDF.Lang ( module DDF.Lang,+ module DDF.Bimap, module DDF.Bool, module DDF.Char, module DDF.Double,- module DDF.Float,- module DDF.Bimap, module DDF.Dual,+ module DDF.Float, module DDF.Meta.Diff,+ module DDF.Ordering, module DDF.Unit, module DDF.Sum, module DDF.Int,@@ -40,6 +41,7 @@ import DDF.DiffWrapper import DDF.Fix import DDF.FreeVector+import DDF.Ordering import qualified DDF.VectorTF as VTF import qualified DDF.Meta.VectorTF as M.VTF@@ -56,7 +58,7 @@ type FreeVectorBuilder b = M.Map.Map b M.Double type SVTFBuilder b = State (M.Bimap.Bimap (M.VTF.VectorTF b M.Int) M.Int) M.Int-class (Bool r, Char r, Double r, Float r, Bimap r, Dual r, Unit r, Sum r, Int r, IO r, VTF.VectorTF r, DiffWrapper r, Fix r, FreeVector r) => Lang r where+class (Ordering r, Char r, Double r, Float r, Bimap r, Dual r, Unit r, Sum r, Int r, IO r, VTF.VectorTF r, DiffWrapper r, Fix r, FreeVector r) => Lang r where exfalso :: r h (Void -> a) writer :: r h ((a, w) -> M.Writer w a) runWriter :: r h (M.Writer w a -> (a, w))
+ DDF/Ordering.hs view
@@ -0,0 +1,26 @@+{-# Language NoImplicitPrelude, NoMonomorphismRestriction #-}++module DDF.Ordering (module DDF.Ordering, module DDF.DBI) where++import DDF.DBI+import DDF.Bool+import qualified Prelude as M++class DBI repr => Ordering repr where+ sel :: repr h (a -> a -> a -> M.Ordering -> a)+ ordering :: M.Ordering -> repr h M.Ordering+ ltOrd :: repr h M.Ordering+ ltOrd = ordering M.LT+ eqOrd :: repr h M.Ordering+ eqOrd = ordering M.EQ+ gtOrd :: repr h M.Ordering+ gtOrd = ordering M.GT++sel1 = app1 sel+sel2 = app2 sel+sel3 = app3 sel+sel4 = app4 sel++isLT = sel3 true false false+isEQ = sel3 false true false+isGT = sel3 false false true
DDF/PE.hs view
@@ -20,6 +20,8 @@ import DDF.Lang import qualified Prelude as M import qualified DDF.Meta.Dual as M+--import qualified DDF.Map as Map+--import qualified Data.Map as M data P repr h a where Open :: (forall hout. EnvT repr h hout -> P repr hout a) -> P repr h a@@ -372,6 +374,27 @@ instance IO repr => IO (P repr) where putStrLn = Unk putStrLn++data MapPE (repr :: * -> * -> *) h k a :: * where+ EmptyMap :: MapPE repr h k a+ SingletonMap :: P repr h k -> P repr h a -> MapPE repr h k a++{-+type instance K repr h (M.Map k a) = MapPE repr h k a+instance Map.Map repr => Map.Map (P repr) where+ empty = static (EmptyMap, Map.empty)+ singleton = abs $ abs $ f (s z) z where+ f :: P repr h k -> P repr h a -> P repr h (M.Map k a)+ f k a =+ know (SingletonMap k a)+ (Map.singleton2 (dynamic k) (dynamic a))+ (\h -> f (app_open k h) (app_open a h))+ (f (s k) (s a))+ lookup = abs $ abs $ f (s z) z where+ f :: P repr h (M.Map k a) -> P repr h k -> P repr h (Maybe a)+ f (Known EmptyMap _ _ _ _) _ = nothing+ f (Known (SingletonMap k a) _ _ _ _) r = ite3 (just1 a) nothing _+-} pe :: DBI repr => P repr () a -> repr () a pe = dynamic
DDF/Show.hs view
@@ -172,3 +172,7 @@ double2Float = name "double2Float" state = name "state" runState = name "runState"++instance Ordering Show where+ ordering = name . show+ sel = name "sel"
DDF/Size.hs view
@@ -137,3 +137,7 @@ double2Float = one state = one runState = one++instance Ordering Size where+ sel = one+ ordering _ = one
DDF/TermGen.hs view
@@ -69,28 +69,6 @@ fix = mkT @Fix fix runFix = mkT @Fix runFix -type instance SubLC c Lang = (- SubL c Fix,- SubL c Int,- SubL c Float,- SubL c Double,- SubL c Bimap,- SubL c IO,- SubL c Sum,- SubL c Dual,- SubL c DiffWrapper,- SubL c FreeVector,- SubL c VTF.VectorTF)--instance SubL c Lang => Lang (Term c) where- state = mkT @Lang state- writer = mkT @Lang writer- exfalso = mkT @Lang exfalso- runState = mkT @Lang runState- runWriter = mkT @Lang runWriter- float2Double = mkT @Lang float2Double- double2Float = mkT @Lang double2Float- type instance SubLC c FreeVector = SubL c DBI instance SubL c FreeVector => FreeVector (Term c) where@@ -109,7 +87,6 @@ char x = mkT @Char (char x) type instance SubLC c Bimap = (SubL c Int, SubL c Map.Map)- instance SubL c Bimap => Bimap (Term c) where size = mkT @Bimap size empty = mkT @Bimap empty@@ -123,7 +100,6 @@ singleton = mkT @Bimap singleton type instance SubLC c Float = SubL c DBI- instance SubL c Float => Float (Term c) where float x = mkT @Float (float x) floatExp = mkT @Float floatExp@@ -133,7 +109,6 @@ floatDivide = mkT @Float floatDivide type instance SubLC c Double = SubL c Bool- instance SubL c Double => Double (Term c) where doubleEq = mkT @Double doubleEq double x = mkT @Double (double x)@@ -178,14 +153,12 @@ bind = mkT @IO bind type instance SubLC c List = SubL c Y- instance SubL c List => List (Term c) where nil = mkT @List nil cons = mkT @List cons listMatch = mkT @List listMatch type instance SubLC c Prod = SubL c DBI- instance SubL c Prod => Prod (Term c) where zro = mkT @Prod zro fst = mkT @Prod fst@@ -197,7 +170,6 @@ y = mkT @Y y type instance SubLC c Map.Map = (SubL c Prod, SubL c Option)- instance SubL c Map.Map => Map.Map (Term c) where empty = mkT @Map.Map Map.empty alter = mkT @Map.Map Map.alter@@ -207,7 +179,6 @@ unionWith = mkT @Map.Map Map.unionWith type instance SubLC c VTF.VectorTF = SubL c Double- instance SubL c VTF.VectorTF => VTF.VectorTF (Term c) where zero = mkT @VTF.VectorTF VTF.zero plus = mkT @VTF.VectorTF VTF.plus@@ -216,12 +187,16 @@ vtfMatch = mkT @VTF.VectorTF VTF.vtfMatch type instance SubLC c Option = SubL c DBI- instance SubL c Option => Option (Term c) where just = mkT @Option just nothing = mkT @Option nothing optionMatch = mkT @Option optionMatch +type instance SubLC c Ordering = SubL c DBI+instance SubL c Ordering => Ordering (Term c) where+ sel = mkT @Ordering sel+ ordering x = mkT @Ordering (ordering x)+ genInstance :: Q [Dec] genInstance = M.mapM gen [@@ -245,7 +220,8 @@ ''Y, ''Dual, ''DiffWrapper,- ''FreeVector]+ ''FreeVector,+ ''Ordering] where gen n = M.return $ InstanceD@@ -253,3 +229,26 @@ [] (AppT (AppT (ConT ''SubL) (ConT ''Lang)) (ConT n)) [ValD (VarP 'sub) (NormalB (AppE (ConE 'Sub) (ConE 'Dict))) []]++type instance SubLC c Lang = (+ SubL c Fix,+ SubL c Int,+ SubL c Float,+ SubL c Double,+ SubL c Bimap,+ SubL c IO,+ SubL c Sum,+ SubL c Dual,+ SubL c DiffWrapper,+ SubL c FreeVector,+ SubL c VTF.VectorTF,+ SubL c Ordering)++instance SubL c Lang => Lang (Term c) where+ state = mkT @Lang state+ writer = mkT @Lang writer+ exfalso = mkT @Lang exfalso+ runState = mkT @Lang runState+ runWriter = mkT @Lang runWriter+ float2Double = mkT @Lang float2Double+ double2Float = mkT @Lang double2Float
DDF/UnHOAS.hs view
@@ -141,3 +141,7 @@ double2Float = UnHOAS double2Float state = UnHOAS state runState = UnHOAS runState++instance Ordering r => Ordering (UnHOAS r) where+ sel = UnHOAS sel+ ordering = UnHOAS . ordering
DDF/UnLiftEnv.hs view
@@ -141,3 +141,7 @@ runState = unLiftEnv runState float2Double = unLiftEnv float2Double double2Float = unLiftEnv double2Float++instance (Prod r, Ordering r) => Ordering (UnLiftEnv r) where+ sel = unLiftEnv sel+ ordering = unLiftEnv . ordering
DeepDarkFantasy.cabal view
@@ -1,5 +1,5 @@ name: DeepDarkFantasy-version: 0.2017.8.17+version: 0.2017.8.18 cabal-version: 1.12 build-type: Simple license: Apache@@ -45,6 +45,7 @@ DDF.Meta.FreeVector DDF.Meta.VectorTF DDF.Option+ DDF.Ordering DDF.PE DDF.Prod DDF.Sam.Hello