patch-image 0.3.3.2 → 0.3.3.3
raw patch · 4 files changed
+182/−182 lines, 4 filesdep ~containersdep ~llvm-extradep ~semigroups
Dependency ranges changed: containers, llvm-extra, semigroups
Files
- patch-image.cabal +12/−12
- src/Knead.hs +117/−117
- src/Knead/Color.hs +19/−19
- src/Knead/Shape.hs +34/−34
patch-image.cabal view
@@ -1,5 +1,5 @@ Name: patch-image-Version: 0.3.3.2+Version: 0.3.3.3 License: BSD3 License-File: LICENSE Author: Henning Thielemann <haskell@henning-thielemann.de>@@ -41,7 +41,7 @@ README.md Source-Repository this- Tag: 0.3.3.2+ Tag: 0.3.3.3 Type: darcs Location: https://hub.darcs.net/thielema/patch-image/ @@ -86,8 +86,8 @@ If flag(llvm) Build-Depends: knead >=1.0 && <1.1,- llvm-extra >=0.11 && <0.12,- llvm-tf >=9.2 && <13.0,+ llvm-extra >=0.12.1 && <0.14,+ llvm-tf >=9.2 && <21.1, tfp >=1.0 && <1.1, comfort-fftw >=0.0 && <0.1, comfort-array >=0.5 && <0.6,@@ -95,20 +95,20 @@ JuicyPixels >=2.0 && <3.4, dsp >=0.2.4 && <0.3, vector >=0.10 && <0.14,- pqueue >=1.2 && <1.5,+ pqueue >=1.2 && <1.6, enumset >=0.0.5 && <0.2,- containers >=0.4.2 && <0.7,- semigroups >=0.1 && <1.0,+ containers >=0.4.2 && <0.9,+ semigroups >=0.1 && <1, storable-complex >=0.2.2 && <0.3, storable-record >=0.0.5 && <0.1, bool8 >=0.0 && <0.1, array >=0.4 && <0.6, cassava >=0.4.5 && <0.6,- unordered-containers >=0.2.5 && <0.2.20,+ unordered-containers >=0.2.5 && <0.3, bytestring >=0.9.2 && <0.13, explicit-exception >=0.1.7 && <0.3, shell-utility >=0.1 && <0.2,- filepath >=1.3 && <1.5,+ filepath >=1.3 && <1.6, non-empty >=0.2 && <0.4, utility-ht >=0.0.16 && <0.1, prelude-compat ==0.0.*,@@ -144,15 +144,15 @@ cassava >=0.4.5 && <0.6, dsp >=0.2.4 && <0.3, gnuplot >=0.5 && <0.6,- containers >=0.4.2 && <0.7,+ containers >=0.4.2 && <0.9, array >=0.4 && <0.6, vector >=0.10 && <0.14,- unordered-containers >=0.2.5 && <0.2.20,+ unordered-containers >=0.2.5 && <0.3, bytestring >=0.9.2 && <0.13, enumset >=0.0.5 && <0.2, explicit-exception >=0.1.7 && <0.3, shell-utility >=0.1 && <0.2,- filepath >=1.3 && <1.5,+ filepath >=1.3 && <1.6, non-empty >=0.2 && <0.4, utility-ht >=0.0.16 && <0.1, base >=4 && <5
src/Knead.hs view
@@ -41,11 +41,11 @@ import qualified Data.Array.Comfort.Storable.Unchecked as ComfortArray import qualified Data.Array.Comfort.Shape as ComfortShape -import qualified LLVM.Extra.Multi.Value.Storable as Storable-import qualified LLVM.Extra.Multi.Value as MultiValue+import qualified LLVM.Extra.Nice.Value.Storable as Storable+import qualified LLVM.Extra.Nice.Value as NiceValue import qualified LLVM.Extra.ScalarOrVector as SoV import qualified LLVM.Extra.Arithmetic as LLVMArith-import LLVM.Extra.Multi.Value (Atom, atom)+import LLVM.Extra.Nice.Value (Atom, atom) import qualified LLVM.Core as LLVM @@ -167,80 +167,80 @@ fromInt ::- (MultiValue.NativeInteger i ir, MultiValue.NativeFloating a ar) =>+ (NiceValue.NativeInteger i ir, NiceValue.NativeFloating a ar) => Exp i -> Exp a-fromInt = Expr.liftM MultiValue.fromIntegral+fromInt = Expr.liftM NiceValue.fromIntegral floatFromByte ::- (MultiValue.NativeFloating a ar,- MultiValue.PseudoRing a, MultiValue.Real a,- MultiValue.RationalConstant a) =>+ (NiceValue.NativeFloating a ar,+ NiceValue.PseudoRing a, NiceValue.Real a,+ NiceValue.RationalConstant a) => Exp Word8 -> Exp a floatFromByte = (* Expr.fromRational' (recip 255)) . fromInt byteFromFloat ::- (MultiValue.NativeFloating a ar,- MultiValue.Field a, MultiValue.Real a,- MultiValue.RationalConstant a) =>+ (NiceValue.NativeFloating a ar,+ NiceValue.Field a, NiceValue.Real a,+ NiceValue.RationalConstant a) => Exp a -> Exp Word8 byteFromFloat = fastRound . (255*) . Expr.max 0 . Expr.min 1 imageFloatFromByte :: (Symb.C array, Shape.C sh,- MultiValue.NativeFloating a ar,- MultiValue.PseudoRing a, MultiValue.Real a,- MultiValue.RationalConstant a) =>+ NiceValue.NativeFloating a ar,+ NiceValue.PseudoRing a, NiceValue.Real a,+ NiceValue.RationalConstant a) => array sh Word8 -> array sh a imageFloatFromByte = Symb.map floatFromByte imageByteFromFloat :: (Symb.C array, Shape.C sh,- MultiValue.NativeFloating a ar,- MultiValue.Field a, MultiValue.Real a,- MultiValue.RationalConstant a) =>+ NiceValue.NativeFloating a ar,+ NiceValue.Field a, NiceValue.Real a,+ NiceValue.RationalConstant a) => array sh a -> array sh Word8 imageByteFromFloat = Symb.map byteFromFloat yuvByteFromFloat ::- (MultiValue.NativeFloating a ar, a ~ ar,- MultiValue.Field a, MultiValue.Real a,- MultiValue.RationalConstant a) =>+ (NiceValue.NativeFloating a ar, a ~ ar,+ NiceValue.Field a, NiceValue.Real a,+ NiceValue.RationalConstant a) => Exp (YUV a) -> Exp (YUV Word8) yuvByteFromFloat = Color.map byteFromFloat colorImageFloatFromByte :: (Symb.C array, Shape.C sh,- MultiValue.NativeFloating a ar, a ~ ar,- MultiValue.PseudoRing a, MultiValue.Real a,- MultiValue.RationalConstant a) =>+ NiceValue.NativeFloating a ar, a ~ ar,+ NiceValue.PseudoRing a, NiceValue.Real a,+ NiceValue.RationalConstant a) => array sh (YUV Word8) -> array sh (YUV a) colorImageFloatFromByte = Symb.map $ Color.map floatFromByte colorImageByteFromFloat :: (Symb.C array, Shape.C sh,- MultiValue.NativeFloating a ar, a ~ ar,- MultiValue.Field a, MultiValue.Real a,- MultiValue.RationalConstant a) =>+ NiceValue.NativeFloating a ar, a ~ ar,+ NiceValue.Field a, NiceValue.Real a,+ NiceValue.RationalConstant a) => array sh (YUV a) -> array sh (YUV Word8) colorImageByteFromFloat = Symb.map yuvByteFromFloat fastRound ::- (MultiValue.NativeInteger i ir, MultiValue.NativeFloating a ar) =>+ (NiceValue.NativeInteger i ir, NiceValue.NativeFloating a ar) => Exp a -> Exp i-fastRound = Expr.liftM MultiValue.roundToIntFast+fastRound = Expr.liftM NiceValue.roundToIntFast splitFraction ::- (MultiValue.NativeFloating a ar) =>+ (NiceValue.NativeFloating a ar) => Exp a -> (Exp Size, Exp a)-splitFraction = Expr.unzip . Expr.liftM MultiValue.splitFractionToInt+splitFraction = Expr.unzip . Expr.liftM NiceValue.splitFractionToInt ceilingToInt ::- (MultiValue.NativeFloating a ar) =>+ (NiceValue.NativeFloating a ar) => Exp a -> Exp Size-ceilingToInt = Expr.liftM MultiValue.ceilingToInt+ceilingToInt = Expr.liftM NiceValue.ceilingToInt @@ -270,7 +270,7 @@ fromSize2 ::- (MultiValue.NativeFloating a ar) =>+ (NiceValue.NativeFloating a ar) => (Exp Size, Exp Size) -> (Exp a, Exp a) fromSize2 (x,y) = (fromInt x, fromInt y) @@ -308,8 +308,8 @@ type VecExp a v = Arith.Vec (Exp a) (Exp v) vecYUV ::- (MultiValue.PseudoRing a, LLVM.IsArithmetic a,- LLVM.IsPrimitive a, LLVM.IsConst a, MultiValue.Repr a ~ LLVM.Value a) =>+ (NiceValue.PseudoRing a, LLVM.IsArithmetic a,+ LLVM.IsPrimitive a, LLVM.IsConst a, NiceValue.Repr a ~ LLVM.Value a) => VecExp a (YUV a) vecYUV = Arith.Vec {@@ -322,9 +322,9 @@ Generated code becomes too big for LLVM here. We need sharing! -} indexFrac ::- (MultiValue.NativeFloating a ar,- MultiValue.Real a, MultiValue.Field a,- MultiValue.RationalConstant a) =>+ (NiceValue.NativeFloating a ar,+ NiceValue.Real a, NiceValue.Field a,+ NiceValue.RationalConstant a) => VecExp a v -> SymbPlane v -> Index2 (Exp a) -> Exp v indexFrac vec img (Vec2 y x) = let (xi,xf) = splitFraction x@@ -344,9 +344,9 @@ yf indexFrac1 ::- (MultiValue.NativeFloating a ar,- MultiValue.Real a, MultiValue.Field a,- MultiValue.RationalConstant a) =>+ (NiceValue.NativeFloating a ar,+ NiceValue.Real a, NiceValue.Field a,+ NiceValue.RationalConstant a) => VecExp a v -> SymbPlane v -> Index2 (Exp a) -> Exp v indexFrac1 vec img (Vec2 y x) = let (xi,xf) = splitFraction x@@ -362,10 +362,10 @@ yf gatherFrac, gatherFrac_ ::- (MultiValue.NativeFloating a ar,- MultiValue.Real a, MultiValue.Field a,- MultiValue.RationalConstant a,- MultiValue.C v) =>+ (NiceValue.NativeFloating a ar,+ NiceValue.Real a, NiceValue.Field a,+ NiceValue.RationalConstant a,+ NiceValue.C v) => VecExp a v -> SymbPlane v -> SymbPlane (Index2 a) ->@@ -404,8 +404,8 @@ rotateStretchMoveCoords :: (SV.Storable a, Storable.C a,- MultiValue.Real a, MultiValue.Field a,- MultiValue.RationalConstant a, MultiValue.NativeFloating a ar) =>+ NiceValue.Real a, NiceValue.Field a,+ NiceValue.RationalConstant a, NiceValue.NativeFloating a ar) => Exp (a, a) -> Exp (a, a) -> Exp Dim2 ->@@ -419,15 +419,15 @@ . Symb.id -inRange :: (MultiValue.Comparison a) => Exp a -> Exp a -> Exp Bool+inRange :: (NiceValue.Comparison a) => Exp a -> Exp a -> Exp Bool inRange = Expr.liftM2 $ \ size x -> do- lower <- MultiValue.cmp LLVM.CmpLE MultiValue.zero x- upper <- MultiValue.cmp LLVM.CmpLT x size- MultiValue.and lower upper+ lower <- NiceValue.cmp LLVM.CmpLE NiceValue.zero x+ upper <- NiceValue.cmp LLVM.CmpLT x size+ NiceValue.and lower upper inBox ::- (MultiValue.Comparison a) =>+ (NiceValue.Comparison a) => (Exp a, Exp a) -> (Exp a, Exp a) -> Exp Bool@@ -435,9 +435,9 @@ inRange width x &&* inRange height y validCoords ::- (MultiValue.NativeFloating a ar,- MultiValue.Field a, MultiValue.Real a,- MultiValue.RationalConstant a) =>+ (NiceValue.NativeFloating a ar,+ NiceValue.Field a, NiceValue.Real a,+ NiceValue.RationalConstant a) => (Exp Size, Exp Size) -> SymbPlane (a, a) -> SymbPlane Bool8 validCoords (width,height) =@@ -451,9 +451,9 @@ -} rotateStretchMove :: (SV.Storable a, Storable.C a,- MultiValue.Real a, MultiValue.Field a,- MultiValue.RationalConstant a, MultiValue.NativeFloating a ar,- MultiValue.C v) =>+ NiceValue.Real a, NiceValue.Field a,+ NiceValue.RationalConstant a, NiceValue.NativeFloating a ar,+ NiceValue.C v) => VecExp a v -> Exp (a, a) -> Exp (a, a) ->@@ -470,9 +470,9 @@ rotate :: (SV.Storable a, Storable.C a,- MultiValue.Real a, MultiValue.Field a,- MultiValue.RationalConstant a, MultiValue.NativeFloating a ar,- MultiValue.C v) =>+ NiceValue.Real a, NiceValue.Field a,+ NiceValue.RationalConstant a, NiceValue.NativeFloating a ar,+ NiceValue.C v) => VecExp a v -> Exp (a, a) -> SymbPlane v ->@@ -498,13 +498,13 @@ brightnessPlane :: (Symb.C array, Shape.C size) =>- (LLVM.IsPrimitive a, MultiValue.Repr a ~ LLVM.Value a) =>+ (LLVM.IsPrimitive a, NiceValue.Repr a ~ LLVM.Value a) => array size (YUV a) -> array size a brightnessPlane = Symb.map Color.brightness rowHistogram ::- (Symb.C array, MultiValue.Additive a) =>- (LLVM.IsPrimitive a, MultiValue.Repr a ~ LLVM.Value a) =>+ (Symb.C array, NiceValue.Additive a) =>+ (LLVM.IsPrimitive a, NiceValue.Repr a ~ LLVM.Value a) => array Dim2 (YUV a) -> array Dim1 a rowHistogram = Symb.fold1 Expr.add .@@ -522,10 +522,10 @@ (Expr.add 1) differentiate ::- (Symb.C array, MultiValue.Additive a) => array Dim1 a -> array Dim1 a+ (Symb.C array, NiceValue.Additive a) => array Dim1 a -> array Dim1 a differentiate xs = Symb.zipWith Expr.sub (tailArr xs) xs -scoreHistogram :: (MultiValue.PseudoRing a) => Symb.Array Dim1 a -> Exp a+scoreHistogram :: (NiceValue.PseudoRing a) => Symb.Array Dim1 a -> Exp a scoreHistogram = Symb.fold1All Expr.add . Symb.map Expr.sqr . differentiate @@ -553,7 +553,7 @@ (Expr.modify atomIx2 $ \(Vec2 x y) -> (Vec2 y x)) lowpassVert, lowpass ::- (MultiValue.Field a, MultiValue.Real a, MultiValue.RationalConstant a) =>+ (NiceValue.Field a, NiceValue.Real a, NiceValue.RationalConstant a) => SymbPlane a -> SymbPlane a lowpassVert img = let height = verticalSize $ Symb.shape img@@ -580,14 +580,14 @@ -- counterpart to 'clip'-pad :: (MultiValue.C a) => Exp a -> Exp Dim2 -> SymbPlane a -> SymbPlane a+pad :: (NiceValue.C a) => Exp a -> Exp Dim2 -> SymbPlane a -> SymbPlane a pad a sh img = let Vec2 height width = decomposeDim2 $ Symb.shape img in generate sh $ \p -> let Vec2 y x = Expr.decompose atomIx2 p in Expr.ifThenElse (y<*height &&* x<*width) (img ! p) a -pad_ :: (MultiValue.C a, sh ~ (dim,dim), dim ~ Shape.Cyclic Size) =>+pad_ :: (NiceValue.C a, sh ~ (dim,dim), dim ~ Shape.Cyclic Size) => Exp a -> Exp sh -> SymbPlane a -> Symb.Array sh a pad_ a sh img = let Vec2 height width = decomposeDim2 $ Symb.shape img@@ -595,7 +595,7 @@ let (y,x) = Expr.decompose (atom,atom) p in Expr.ifThenElse (y<*height &&* x<*width) (img ! ix2 y x) a -cyclicReverse2d :: (MultiValue.C a) => SymbPlane a -> SymbPlane a+cyclicReverse2d :: (NiceValue.C a) => SymbPlane a -> SymbPlane a cyclicReverse2d spec = let (Vec2 height width) = decomposeDim2 $ Symb.shape spec in Symb.backpermute (Symb.shape spec)@@ -609,8 +609,8 @@ atomComplex = atom:+atom untangleSpectra2d ::- (MultiValue.C a, MultiValue.Field a,- MultiValue.Real a, MultiValue.RationalConstant a) =>+ (NiceValue.C a, NiceValue.Field a,+ NiceValue.Real a, NiceValue.RationalConstant a) => SymbPlane (Complex a) -> SymbPlane (Complex a, Complex a) untangleSpectra2d spec = Symb.zipWith@@ -618,8 +618,8 @@ spec (cyclicReverse2d spec) correlatePadded ::- (Class.Real a, MultiValue.Real a, Storable.C a,- MultiValue.Field a, MultiValue.RationalConstant a) =>+ (Class.Real a, NiceValue.Real a, Storable.C a,+ NiceValue.Field a, NiceValue.RationalConstant a) => Dim2 -> IO (Plane a -> Plane a -> IO (Plane a)) correlatePadded shape@(Vec2 (Shape.ZeroBased height) (Shape.ZeroBased width)) = do@@ -685,8 +685,8 @@ that are actually digitalization artifacts. -} minimumOverlapScores ::- (MultiValue.Select a, MultiValue.PseudoRing a,- MultiValue.IntegerConstant a, MultiValue.Real a) =>+ (NiceValue.Select a, NiceValue.PseudoRing a,+ NiceValue.IntegerConstant a, NiceValue.Real a) => ((Exp Size, Exp Size) -> Exp a -> Exp a) -> Exp Size -> (Exp Size, Exp Size) -> (Exp Size, Exp Size) -> SymbPlane (a, (Size, Size)) ->@@ -750,13 +750,13 @@ argmax ::- (MultiValue.Comparison a, MultiValue.Select a, MultiValue.Select b) =>+ (NiceValue.Comparison a, NiceValue.Select a, NiceValue.Select b) => Exp (a, b) -> Exp (a, b) -> Exp (a, b) argmax x y = Expr.select (Expr.fst x <=* Expr.fst y) y x argmaximum :: (Shape.C sh,- MultiValue.Comparison a, MultiValue.Select a, MultiValue.Select b) =>+ NiceValue.Comparison a, NiceValue.Select a, NiceValue.Select b) => Symb.Array sh (a, b) -> Exp (a, b) argmaximum = Symb.fold1All argmax @@ -774,8 +774,8 @@ shrink ::- (MultiValue.Field a, MultiValue.RationalConstant a, MultiValue.Real a,- MultiValue.NativeFloating a ar) =>+ (NiceValue.Field a, NiceValue.RationalConstant a, NiceValue.Real a,+ NiceValue.NativeFloating a ar) => Factor2 (Exp Size) -> SymbPlane a -> SymbPlane a shrink (Vec2 yk xk) = Symb.map (/ (fromInt xk * fromInt yk)) .@@ -847,7 +847,7 @@ clip ::- (MultiValue.C a) =>+ (NiceValue.C a) => (Exp Size, Exp Size) -> (Exp Size, Exp Size) -> SymbPlane a -> SymbPlane a@@ -983,8 +983,8 @@ overlapDifference ::- (MultiValue.Algebraic a, MultiValue.RationalConstant a,- MultiValue.Real a, MultiValue.NativeFloating a ar) =>+ (NiceValue.Algebraic a, NiceValue.RationalConstant a,+ NiceValue.Real a, NiceValue.NativeFloating a ar) => (Exp Size, Exp Size) -> SymbPlane a -> SymbPlane a -> Exp a overlapDifference (dx,dy) a b =@@ -1011,8 +1011,8 @@ overlap2 ::- (MultiValue.Field a, MultiValue.Real a, MultiValue.RationalConstant a,- MultiValue.C v) =>+ (NiceValue.Field a, NiceValue.Real a, NiceValue.RationalConstant a,+ NiceValue.C v) => VecExp a v -> (Exp Size, Exp Size) -> (SymbPlane v, SymbPlane v) -> SymbPlane v@@ -1061,7 +1061,7 @@ type RotatedImage = ((Float,Float), (Float,Float), ColorImage8) addToCountCanvas ::- (MultiValue.PseudoRing a, MultiValue.NativeFloating a ar) =>+ (NiceValue.PseudoRing a, NiceValue.NativeFloating a ar) => VecExp a v -> SymbPlane (Bool8, v) -> SymbPlane (Word32, v) ->@@ -1094,8 +1094,8 @@ Symb.fix -diffAbs :: (MultiValue.Real a) => Exp a -> Exp a -> Exp a-diffAbs = Expr.liftM2 $ \x y -> MultiValue.abs =<< MultiValue.sub x y+diffAbs :: (NiceValue.Real a) => Exp a -> Exp a -> Exp a+diffAbs = Expr.liftM2 $ \x y -> NiceValue.abs =<< NiceValue.sub x y diffWithCanvas :: IO (RotatedImage -> Plane (YUV Float) -> IO (Planes (Bool8, Float)))@@ -1154,7 +1154,7 @@ maybePlus ::- (MultiValue.C a) =>+ (NiceValue.C a) => (Exp a -> Exp a -> Exp a) -> Exp (Bool, a) -> Exp (Bool, a) -> Exp (Bool, a) maybePlus f x y =@@ -1164,7 +1164,7 @@ (Expr.compose (Expr.true, Expr.ifThenElse yb (f xv yv) xv)) y maskedMinimum ::- (Shape.C sh, Symb.C array, MultiValue.Real a) =>+ (Shape.C sh, Symb.C array, NiceValue.Real a) => array (sh, SmallDim) (Bool, a) -> array sh (Bool, a) maskedMinimum = Symb.fold1 (maybePlus Expr.min) @@ -1177,8 +1177,8 @@ type Geometry a = Arith.Geometry Size a distanceMapBox ::- (MultiValue.Field a, MultiValue.NativeFloating a ar,- MultiValue.Real a, MultiValue.RationalConstant a) =>+ (NiceValue.Field a, NiceValue.NativeFloating a ar,+ NiceValue.Real a, NiceValue.RationalConstant a) => Exp Dim2 -> Exp (Geometry a) -> SymbPlane (Bool, (((a,(a,a)), (a,(a,a))), ((a,(a,a)), (a,(a,a)))))@@ -1202,8 +1202,8 @@ (bottomDist, forth (xsrc,heightf))))) distance ::- (MultiValue.Algebraic a, MultiValue.Real a,- MultiValue.IntegerConstant a) =>+ (NiceValue.Algebraic a, NiceValue.Real a,+ NiceValue.IntegerConstant a) => Arith.Point2 (Exp a) -> Arith.Point2 (Exp a) -> Exp a distance a b = Expr.sqrt $ Arith.distanceSqr a b @@ -1215,19 +1215,19 @@ ShapeDep.backpermute2 Expr.zip Expr.fst Expr.snd isZero ::- (MultiValue.Comparison i, MultiValue.Integral i,- MultiValue.IntegerConstant i) =>+ (NiceValue.Comparison i, NiceValue.Integral i,+ NiceValue.IntegerConstant i) => Exp i -> Exp Bool isZero = (==* Expr.zero) expEven ::- (MultiValue.Comparison i, MultiValue.Integral i,- MultiValue.IntegerConstant i) =>+ (NiceValue.Comparison i, NiceValue.Integral i,+ NiceValue.IntegerConstant i) => Exp i -> Exp Bool expEven = isZero . flip Expr.irem 2 separateDistanceMap ::- (Symb.C array, Shape.C sh, MultiValue.C a) =>+ (Symb.C array, Shape.C sh, NiceValue.C a) => array sh (bool, ((a, a), (a, a))) -> array (sh, SmallDim) (bool, a) separateDistanceMap array =@@ -1255,8 +1255,8 @@ containedAnywhere :: (Symb.C array, Shape.C sh,- MultiValue.Field a, MultiValue.NativeFloating a ar,- MultiValue.Real a, MultiValue.RationalConstant a) =>+ NiceValue.Field a, NiceValue.NativeFloating a ar,+ NiceValue.Real a, NiceValue.RationalConstant a) => array SmallDim (Geometry a) -> array sh (a,a) -> array sh Bool@@ -1271,8 +1271,8 @@ distanceMapContained ::- (MultiValue.RationalConstant a, MultiValue.NativeFloating a ar,- MultiValue.PseudoRing a, MultiValue.Field a, MultiValue.Real a) =>+ (NiceValue.RationalConstant a, NiceValue.NativeFloating a ar,+ NiceValue.PseudoRing a, NiceValue.Field a, NiceValue.Real a) => Exp Dim2 -> Exp (Geometry a) -> Symb.Array SmallDim (Geometry a) ->@@ -1301,8 +1301,8 @@ return $ \sh this others -> distances sh this =<< geometryVector others scaleDistanceMapGeom ::- (MultiValue.Field a, MultiValue.Real a, MultiValue.RationalConstant a,- MultiValue.NativeFloating a ar) =>+ (NiceValue.Field a, NiceValue.Real a, NiceValue.RationalConstant a,+ NiceValue.NativeFloating a ar) => Exp (Geometry b) -> SymbPlane a -> SymbPlane Word8 scaleDistanceMapGeom geom img = let scale = (4/) $ fromInt $ Expr.uncurry Expr.min $ Expr.thd3 geom@@ -1336,13 +1336,13 @@ pixelCoordinates ::- (MultiValue.NativeFloating a ar) => Exp Dim2 -> SymbPlane (a,a)+ (NiceValue.NativeFloating a ar) => Exp Dim2 -> SymbPlane (a,a) pixelCoordinates sh = generate sh $ Expr.modify atomIx2 $ \(Vec2 y x) -> fromSize2 (x,y) distanceMapPoints :: (Shape.C sh, Symb.C array,- MultiValue.Real a, MultiValue.Algebraic a, MultiValue.IntegerConstant a) =>+ NiceValue.Real a, NiceValue.Algebraic a, NiceValue.IntegerConstant a) => array sh (a,a) -> array SmallDim (a,a) -> array sh a@@ -1362,8 +1362,8 @@ scaleDistanceMap ::- (MultiValue.Field a, MultiValue.Real a, MultiValue.RationalConstant a,- MultiValue.NativeFloating a ar) =>+ (NiceValue.Field a, NiceValue.Real a, NiceValue.RationalConstant a,+ NiceValue.NativeFloating a ar) => SymbPlane a -> SymbPlane Word8 scaleDistanceMap img = let scale =@@ -1388,9 +1388,9 @@ and chose the minimal distance. -} distanceMap ::- (MultiValue.Algebraic a, MultiValue.Real a,- MultiValue.RationalConstant a,- MultiValue.NativeFloating a ar) =>+ (NiceValue.Algebraic a, NiceValue.Real a,+ NiceValue.RationalConstant a,+ NiceValue.NativeFloating a ar) => Exp Dim2 -> Exp (Geometry a) -> Symb.Array SmallDim (Geometry a) ->@@ -1419,15 +1419,15 @@ pow ::- (MultiValue.Repr a ~ LLVM.Value ar,+ (NiceValue.Repr a ~ LLVM.Value ar, LLVM.IsFloating ar, SoV.TranscendentalConstant ar) => Exp a -> Exp a -> Exp a pow = flip $ Expr.liftReprM2 LLVMArith.pow distanceMapGamma ::- (MultiValue.Algebraic a, MultiValue.Real a,- MultiValue.RationalConstant a,- MultiValue.NativeFloating a ar,+ (NiceValue.Algebraic a, NiceValue.Real a,+ NiceValue.RationalConstant a,+ NiceValue.NativeFloating a ar, SoV.TranscendentalConstant ar) => Exp a -> Exp Dim2 ->@@ -1445,7 +1445,7 @@ Symb.fill sh $ Expr.tuple $ Expr.zip 0 $ Color.yuv 0 0 0 addToWeightedCanvas ::- (MultiValue.PseudoRing a, MultiValue.NativeFloating a ar) =>+ (NiceValue.PseudoRing a, NiceValue.NativeFloating a ar) => VecExp a v -> SymbPlane (a, v) -> SymbPlane (a, v) ->
src/Knead/Color.hs view
@@ -8,9 +8,9 @@ import qualified Data.Array.Knead.Expression as Expr import Data.Array.Knead.Expression (Exp) -import qualified LLVM.Extra.Multi.Value.Storable as Storable-import qualified LLVM.Extra.Multi.Vector as MultiVector-import qualified LLVM.Extra.Multi.Value as MultiValue+import qualified LLVM.Extra.Nice.Value.Storable as Storable+import qualified LLVM.Extra.Nice.Vector as NiceVector+import qualified LLVM.Extra.Nice.Value as NiceValue import qualified LLVM.Extra.Vector as Vector import qualified LLVM.Extra.Tuple as Tuple @@ -58,11 +58,11 @@ instance (Storable.Vector a, LLVM.IsPrimitive a, LLVM.IsConst a,- MultiVector.C a,- MultiVector.Repr TypeNum.D3 a ~ LLVM.Value (LLVM.Vector TypeNum.D3 a)) =>+ NiceVector.C a,+ NiceVector.Repr TypeNum.D3 a ~ LLVM.Value (LLVM.Vector TypeNum.D3 a)) => Storable.C (YUV a) where- load = fmap MultiValue.cast . Storable.load <=< castVectorPtr- store x = Storable.store (MultiValue.cast x) <=< castVectorPtr+ load = fmap NiceValue.cast . Storable.load <=< castVectorPtr+ store x = Storable.store (NiceValue.cast x) <=< castVectorPtr castVectorPtr :: LLVM.Value (Ptr (YUV a)) ->@@ -78,18 +78,18 @@ instance (LLVM.IsPrimitive a, LLVM.IsConst a) =>- MultiValue.C (YUV a) where+ NiceValue.C (YUV a) where type Repr (YUV a) = LLVM.Value (LLVM.Vector TypeNum.D3 a) cons (YUV a0 a1 a2) =- MultiValue.Cons $ LLVM.valueOf $ LLVM.consVector a0 a1 a2- undef = MultiValue.undefTuple- zero = MultiValue.zeroTuple- phi = MultiValue.phiTuple- addPhi = MultiValue.addPhiTuple+ NiceValue.Cons $ LLVM.valueOf $ LLVM.consVector a0 a1 a2+ undef = NiceValue.undefTuple+ zero = NiceValue.zeroTuple+ phi = NiceValue.phiTuple+ addPhi = NiceValue.addPhiTuple yuv ::- (LLVM.IsPrimitive a, MultiValue.Repr a ~ LLVM.Value a) =>+ (LLVM.IsPrimitive a, NiceValue.Repr a ~ LLVM.Value a) => Exp a -> Exp a -> Exp a -> Exp (YUV a) yuv = Expr.liftReprM3@@ -99,7 +99,7 @@ LLVM.insertelement arr1 v (LLVM.valueOf 2)) brightness ::- (LLVM.IsPrimitive a, MultiValue.Repr a ~ LLVM.Value a) =>+ (LLVM.IsPrimitive a, NiceValue.Repr a ~ LLVM.Value a) => Exp (YUV a) -> Exp a brightness = Expr.liftReprM (flip LLVM.extractelement (LLVM.valueOf 0))@@ -111,13 +111,13 @@ mapPlain f = Expr.liftReprM (Vector.map f) exprUnliftM1 ::- (MultiValue.Repr a ~ al, MultiValue.Repr b ~ bl) =>+ (NiceValue.Repr a ~ al, NiceValue.Repr b ~ bl) => (Exp a -> Exp b) -> al -> LLVM.CodeGenFunction r bl exprUnliftM1 f a =- fmap (\(MultiValue.Cons b) -> b) $ Expr.unliftM1 f $ MultiValue.Cons a+ fmap (\(NiceValue.Cons b) -> b) $ Expr.unliftM1 f $ NiceValue.Cons a map ::- (LLVM.IsPrimitive a, MultiValue.Repr a ~ LLVM.Value a,- LLVM.IsPrimitive b, MultiValue.Repr b ~ LLVM.Value b) =>+ (LLVM.IsPrimitive a, NiceValue.Repr a ~ LLVM.Value a,+ LLVM.IsPrimitive b, NiceValue.Repr b ~ LLVM.Value b) => (Exp a -> Exp b) -> Exp (YUV a) -> Exp (YUV b) map f = mapPlain (exprUnliftM1 f)
src/Knead/Shape.hs view
@@ -8,13 +8,13 @@ import qualified Data.Array.Comfort.Shape as ComfortShape -import qualified LLVM.Extra.Multi.Value.Marshal as Marshal-import qualified LLVM.Extra.Multi.Value as MultiValue+import qualified LLVM.Extra.Nice.Value.Marshal as Marshal+import qualified LLVM.Extra.Nice.Value as NiceValue import qualified LLVM.Extra.Memory as Memory import qualified LLVM.Extra.Tuple as Tuple import qualified LLVM.Extra.Iterator as Iter import qualified LLVM.Extra.Arithmetic as A-import LLVM.Extra.Multi.Value (atom)+import LLVM.Extra.Nice.Value (atom) import qualified LLVM.Core as LLVM @@ -98,43 +98,43 @@ type ValueOf (Vec2 tag n) = Vec2 tag (Tuple.ValueOf n) valueOf (Vec2 n m) = Vec2 (Tuple.valueOf n) (Tuple.valueOf m) -instance (MultiValue.C n) => MultiValue.C (Vec2 tag n) where- type Repr (Vec2 tag n) = Vec2 tag (MultiValue.Repr n)+instance (NiceValue.C n) => NiceValue.C (Vec2 tag n) where+ type Repr (Vec2 tag n) = Vec2 tag (NiceValue.Repr n) cons (Vec2 n m) =- MultiValue.compose $ Vec2 (MultiValue.cons n) (MultiValue.cons m)- undef = MultiValue.compose $ squareShape MultiValue.undef- zero = MultiValue.compose $ squareShape MultiValue.zero+ NiceValue.compose $ Vec2 (NiceValue.cons n) (NiceValue.cons m)+ undef = NiceValue.compose $ squareShape NiceValue.undef+ zero = NiceValue.compose $ squareShape NiceValue.zero phi bb a =- case MultiValue.decompose (squareShape atom) a of+ case NiceValue.decompose (squareShape atom) a of Vec2 a0 a1 ->- fmap MultiValue.compose $- Monad.lift2 Vec2 (MultiValue.phi bb a0) (MultiValue.phi bb a1)+ fmap NiceValue.compose $+ Monad.lift2 Vec2 (NiceValue.phi bb a0) (NiceValue.phi bb a1) addPhi bb a b =- case (MultiValue.decompose (squareShape atom) a,- MultiValue.decompose (squareShape atom) b) of+ case (NiceValue.decompose (squareShape atom) a,+ NiceValue.decompose (squareShape atom) b) of (Vec2 a0 a1, Vec2 b0 b1) ->- MultiValue.addPhi bb a0 b0 >>- MultiValue.addPhi bb a1 b1+ NiceValue.addPhi bb a0 b0 >>+ NiceValue.addPhi bb a1 b1 type instance- MultiValue.Decomposed f (Vec2 tag pat) =- Vec2 tag (MultiValue.Decomposed f pat)+ NiceValue.Decomposed f (Vec2 tag pat) =+ Vec2 tag (NiceValue.Decomposed f pat) type instance- MultiValue.PatternTuple (Vec2 tag pat) =- Vec2 tag (MultiValue.PatternTuple pat)+ NiceValue.PatternTuple (Vec2 tag pat) =+ Vec2 tag (NiceValue.PatternTuple pat) -instance (MultiValue.Compose n) => MultiValue.Compose (Vec2 tag n) where- type Composed (Vec2 tag n) = Vec2 tag (MultiValue.Composed n)+instance (NiceValue.Compose n) => NiceValue.Compose (Vec2 tag n) where+ type Composed (Vec2 tag n) = Vec2 tag (NiceValue.Composed n) compose (Vec2 n m) =- case (MultiValue.compose n, MultiValue.compose m) of- (MultiValue.Cons rn, MultiValue.Cons rm) ->- MultiValue.Cons (Vec2 rn rm)+ case (NiceValue.compose n, NiceValue.compose m) of+ (NiceValue.Cons rn, NiceValue.Cons rm) ->+ NiceValue.Cons (Vec2 rn rm) -instance (MultiValue.Decompose pn) => MultiValue.Decompose (Vec2 tag pn) where- decompose (Vec2 pn pm) (MultiValue.Cons (Vec2 n m)) =+instance (NiceValue.Decompose pn) => NiceValue.Decompose (Vec2 tag pn) where+ decompose (Vec2 pn pm) (NiceValue.Cons (Vec2 n m)) = Vec2- (MultiValue.decompose pn (MultiValue.Cons n))- (MultiValue.decompose pm (MultiValue.Cons m))+ (NiceValue.decompose pn (NiceValue.Cons n))+ (NiceValue.decompose pm (NiceValue.Cons m)) instance (Memory.C i) => Memory.C (Vec2 tag i) where type Struct (Vec2 tag i) =@@ -155,11 +155,11 @@ LLVM.uncurryStruct $ \n m -> Vec2 (Marshal.unpack n) (Marshal.unpack m) -unzipShape :: MultiValue.T (Vec2 tag n) -> Vec2 tag (MultiValue.T n)-unzipShape = MultiValue.decompose (squareShape atom)+unzipShape :: NiceValue.T (Vec2 tag n) -> Vec2 tag (NiceValue.T n)+unzipShape = NiceValue.decompose (squareShape atom) -zipShape :: MultiValue.T n -> MultiValue.T n -> MultiValue.T (Vec2 tag n)-zipShape y x = MultiValue.compose $ Vec2 y x+zipShape :: NiceValue.T n -> NiceValue.T n -> NiceValue.T (Vec2 tag n)+zipShape y x = NiceValue.compose $ Vec2 y x instance (tag ~ ShapeTag, ComfortShape.C i) => ComfortShape.C (Vec2 tag i) where size (Vec2 n m) = ComfortShape.size n * ComfortShape.size m@@ -220,8 +220,8 @@ (Expr.decompose pm (horizontalVal vec)) verticalVal, horizontalVal :: (Expr.Value val) => val (Vec2 tag n) -> val n-verticalVal = Expr.lift1 (MultiValue.lift1 vertical)-horizontalVal = Expr.lift1 (MultiValue.lift1 horizontal)+verticalVal = Expr.lift1 (NiceValue.lift1 vertical)+horizontalVal = Expr.lift1 (NiceValue.lift1 horizontal) verticalSize, horizontalSize :: (Expr.Value val) => val (Shape2 (Shape.ZeroBased n)) -> val n