llvm-dsl 0.2.0.1 → 0.2.1

raw patch · 8 files changed

+386/−12 lines, 8 filesdep +QuickCheckdep +doctest-libdep +non-emptydep ~llvm-extradep ~utility-htPVP ok

version bump matches the API change (PVP)

Dependencies added: QuickCheck, doctest-lib, non-empty

Dependency ranges changed: llvm-extra, utility-ht

API changes (from Hackage documentation)

Files

• Justfile +10/−0
• Makefile +0/−5
• llvm-dsl.cabal +10/−4
• src/LLVM/DSL/Expression.hs +6/−0
• src/LLVM/DSL/Expression/Vector.hs +153/−2
• test/DocTest/LLVM/DSL/Expression/Vector.hs +156/−0
• test/Main.hs +2/−1
• test/Test/LLVM/DSL/Run.hs +49/−0

@@ -0,0 +1,10 @@+run-test:	update-test+	runhaskell Setup.lhs configure --user -f-debug+	runhaskell Setup.lhs build+	runhaskell Setup.lhs configure --user -fdebug+	runhaskell Setup.lhs build++update-test:+	doctest-extract-0.1 -i src/ -o test/ \+	  --module-prefix DocTest --library-main=Main \+	  LLVM.DSL.Expression.Vector

@@ -1,5 +0,0 @@-run-test:-	runhaskell Setup.lhs configure --user -f-debug-	runhaskell Setup.lhs build-	runhaskell Setup.lhs configure --user -fdebug-	runhaskell Setup.lhs build

@@ -1,6 +1,6 @@ Cabal-Version:  2.2 Name:           llvm-dsl-Version:        0.2.0.1+Version:        0.2.1 License:        BSD-3-Clause License-File:   LICENSE Author:         Henning Thielemann <haskell@henning-thielemann.de>@@ -26,14 +26,14 @@ Tested-With:    GHC==9.0.2, GHC==9.2.8, GHC==9.4.6 Build-Type:     Simple Extra-Source-Files:-  Makefile+  Justfile  Source-Repository head   Type:     darcs   Location: https://hub.darcs.net/thielema/llvm-dsl/  Source-Repository this-  Tag:      0.2.0.1+  Tag:      0.2.1   Type:     darcs   Location: https://hub.darcs.net/thielema/llvm-dsl/ @@ -44,7 +44,7 @@  Library   Build-Depends:-    llvm-extra >=0.12.1 && <0.14,+    llvm-extra >=0.13.1 && <0.14,     llvm-tf >=9.0 && <21.1,     tfp >=1.0 && <1.1,     numeric-prelude >=0.4.3 && <0.5,@@ -85,10 +85,14 @@   Type: exitcode-stdio-1.0   Build-Depends:     doctest-exitcode-stdio >=0.0 && <0.1,+    doctest-lib >=0.1.1 && <0.2,+    QuickCheck >=2.11 && <3,     llvm-dsl,     llvm-extra,     llvm-tf,     tfp,+    non-empty >=0.3.3 && <0.4,+    utility-ht,     transformers,     base >=3 && <5 @@ -97,4 +101,6 @@   Hs-source-dirs: test   Main-Is: Main.hs   Other-Modules:+    DocTest.LLVM.DSL.Expression.Vector+    Test.LLVM.DSL.Run     Test.LLVM.DSL.Example.Median

@@ -266,6 +266,12 @@    Exp (a0,b0,c0) -> Exp (a1,b1,c1) mapTriple (f,g,h) = mapFst3 f . mapSnd3 g . mapThd3 h +curry3 :: (Exp (a,b,c) -> d) -> (Exp a -> Exp b -> Exp c -> d)+curry3 f = TupleHT.curry3 (f . TupleHT.uncurry3 zip3)++uncurry3 :: (Exp a -> Exp b -> Exp c -> d) -> (Exp (a,b,c) -> d)+uncurry3 f = TupleHT.uncurry3 f . unzip3+  tuple :: Exp tuple -> Exp (StTuple.Tuple tuple) tuple = lift1 NiceValue.tuple

@@ -17,6 +17,26 @@ import Prelude hiding (replicate, take, zip, fst, snd, min, max)  +{- $setup+>>> import Test.LLVM.DSL.Run (sharedRun, run)+>>> import qualified LLVM.DSL.Expression.Vector as Vector+>>> import qualified LLVM.DSL.Expression as Expr+>>> import qualified LLVM.Core as LLVM+>>> import Type.Data.Num.Decimal (D4, D8)+>>> import qualified Data.Traversable as Trav+>>> import qualified Data.Foldable as Fold+>>> import qualified Data.List as List+>>> import qualified Data.NonEmpty as NonEmpty+>>> import qualified Data.Tuple.HT as Tuple+>>> import Control.Applicative (liftA2)+>>> import Data.Int (Int32)+>>> import Test.QuickCheck ((===))+>>>+>>> type N = D8+>>> type VectorN = LLVM.Vector N+-}++ cons ::    (LLVM.Positive n, NiceVector.C a) =>    LLVM.Vector n a -> Exp (LLVM.Vector n a)@@ -85,11 +105,47 @@ zip3 = Expr.lift3 NiceValueVec.zip3  +{- |+>>> run Vector.replicate 42 :: LLVM.Vector D4 Int32+Vector [42,42,42,42]+-} replicate ::    (LLVM.Positive n, NiceVector.C a) =>    Exp a -> Exp (LLVM.Vector n a) replicate = Expr.liftM NiceValueVec.replicate +{- |+>>> run (Expr.uncurry3 Vector.replicateSegmented) (LLVM.consVector False False True False False True False False, 8, LLVM.consVector 7 6 5 4 3 2 1 0) :: LLVM.Vector D8 Int32+Vector [8,8,5,5,5,2,2,2]++prop> :{+   sharedRun (Expr.uncurry3 Vector.replicateSegmented) $ \replicateSegmented ->+   \bs x xs ->+      NonEmpty.tail+         (NonEmpty.scanl (\lastX (b,xi) -> if b then xi else lastX)+            x (liftA2 (,) bs xs))+      ===+      replicateSegmented (bs, x, xs :: VectorN Int32)+:}+-}+replicateSegmented ::+   (LLVM.Positive n, NiceVector.Select a) =>+   Exp (LLVM.Vector n Bool) -> Exp a -> Exp (LLVM.Vector n a) ->+   Exp (LLVM.Vector n a)+replicateSegmented = Expr.liftM3 NiceValueVec.replicateSegmented++{- |+>>> run (Vector.iterate (6+)) 0 :: LLVM.Vector D8 Int32+Vector [0,6,12,18,24,30,36,42]++prop> :{+   sharedRun (Expr.uncurry (\d -> Vector.iterate (d+))) $ \iter ->+   \d x ->+      List.take 8 (List.iterate (d+) x)+      ===+      Fold.toList (iter (d,x) :: LLVM.Vector D8 Int32)+:}+-} iterate ::    (LLVM.Positive n, NiceVector.C a) =>    (Exp a -> Exp a) -> Exp a -> Exp (LLVM.Vector n a)@@ -106,17 +162,112 @@ takeRev = Expr.liftM NiceValueVec.takeRev  +{- |+Same as 'cumulateJoint' but misses sharing.+That is, cumulation operations is effictively computed twice,+unless LLVM optimization eliminates it.+However, interim code can blow up+if many such unshared operations are nested.+-} cumulate ::    (LLVM.Positive n, NiceVector.Additive a) =>    Exp a -> Exp (LLVM.Vector n a) -> (Exp a, Exp (LLVM.Vector n a))-cumulate a0 v0 =-   Expr.unzip $+cumulate a v = Expr.unzip $ cumulateJoint a v++{- |+>>> run (Expr.uncurry Vector.cumulateJoint) (3, LLVM.consVector 1 4 1 5 :: LLVM.Vector D4 Int32)+(14,Vector [3,4,8,9])++prop> :{+   sharedRun (Expr.uncurry Vector.cumulateJoint) $ \cumulateJoint ->+   \x xs ->+      Tuple.swap (NonEmpty.viewR (NonEmpty.scanl (+) x xs))+      ===+      cumulateJoint (x, xs :: VectorN Int32)+:}+-}+cumulateJoint ::+   (LLVM.Positive n, NiceVector.Additive a) =>+   Exp a -> Exp (LLVM.Vector n a) -> Exp (a, LLVM.Vector n a)+cumulateJoint a0 v0 =    Expr.liftM2       (\a v ->          fmap (uncurry NiceValue.zip .                Tuple.mapSnd NiceVectorInst.toNiceValue) $          NiceVector.cumulate a $ NiceVectorInst.fromNiceValue v)       a0 v0++{- |+>>> run Vector.cumulate1 (LLVM.consVector 3 1 4 1 :: LLVM.Vector D4 Int32)+Vector [3,4,8,9]++>>> run Vector.cumulate1 (LLVM.consVector 3 1 4 1 5 9 2 6 :: LLVM.Vector D8 Int32)+Vector [3,4,8,9,14,23,25,31]++>>> run Vector.cumulate1 (LLVM.consVector 0 0 1 0 0 (-1) 0 0 :: LLVM.Vector D8 Int32)+Vector [0,0,1,1,1,0,0,0]++prop> :{+   sharedRun Vector.cumulate1 $ \cumulate1 ->+   \x ->+      scanl1 (+) (Fold.toList x)+      ===+      Fold.toList (cumulate1 (x :: VectorN Int32))+:}++prop> :{+   sharedRun Vector.cumulate1 $ \cumulate1 ->+   \x ->+      NonEmpty.tail (NonEmpty.scanl (+) 0 x)+      ===+      cumulate1 (x :: VectorN Int32)+:}+-}+cumulate1 ::+   (LLVM.Positive n, NiceVector.Additive a) =>+   Exp (LLVM.Vector n a) -> Exp (LLVM.Vector n a)+cumulate1 =+   Expr.liftM+      (fmap NiceVectorInst.toNiceValue .+       NiceVector.cumulate1 .+       NiceVectorInst.fromNiceValue)++cumulateSegmented ::+   (LLVM.Positive n, NiceVector.Additive a, NiceVector.Select a) =>+   Exp (LLVM.Vector n Bool) -> Exp a -> Exp (LLVM.Vector n a) ->+   (Exp a, Exp (LLVM.Vector n a))+cumulateSegmented b a v = Expr.unzip $ cumulateSegmentedJoint b a v++{- |+>>> run (Expr.uncurry3 Vector.cumulateSegmentedJoint) (LLVM.consVector False False True False False True False False, 3, LLVM.consVector 1 4 1 5 9 2 6 5) :: (Int32, LLVM.Vector D8 Int32)+(13,Vector [3,4,0,1,6,0,2,8])++prop> :{+   sharedRun (Expr.uncurry3 Vector.cumulateSegmentedJoint) $+   \cumulateSegmentedJoint ->+   \bs x xs ->+      Trav.mapAccumL+         (\acc (b,xi) ->+            let yi = if b then 0 else acc in (yi+xi, yi))+         x (liftA2 (,) bs xs)+      ===+      cumulateSegmentedJoint (bs, x, xs :: VectorN Int32)+:}+-}+cumulateSegmentedJoint ::+   (LLVM.Positive n, NiceVector.Additive a, NiceVector.Select a) =>+   Exp (LLVM.Vector n Bool) -> Exp a -> Exp (LLVM.Vector n a) ->+   Exp (a, LLVM.Vector n a)+cumulateSegmentedJoint b0 a0 v0 =+   Expr.liftM3+      (\b a v ->+         fmap (uncurry NiceValue.zip .+               Tuple.mapSnd NiceVectorInst.toNiceValue) $+         NiceVector.cumulateSegmented+            (NiceVectorInst.fromNiceValue b)+            a+            (NiceVectorInst.fromNiceValue v))+      b0 a0 v0   cmp ::

@@ -0,0 +1,156 @@+-- Do not edit! Automatically created with doctest-extract from src/LLVM/DSL/Expression/Vector.hs+{-# LINE 20 "src/LLVM/DSL/Expression/Vector.hs" #-}++module DocTest.LLVM.DSL.Expression.Vector where++import Test.DocTest.Base+import qualified Test.DocTest.Driver as DocTest++{-# LINE 21 "src/LLVM/DSL/Expression/Vector.hs" #-}+import     Test.LLVM.DSL.Run (sharedRun, run)+import     qualified LLVM.DSL.Expression.Vector as Vector+import     qualified LLVM.DSL.Expression as Expr+import     qualified LLVM.Core as LLVM+import     Type.Data.Num.Decimal (D4, D8)+import     qualified Data.Traversable as Trav+import     qualified Data.Foldable as Fold+import     qualified Data.List as List+import     qualified Data.NonEmpty as NonEmpty+import     qualified Data.Tuple.HT as Tuple+import     Control.Applicative (liftA2)+import     Data.Int (Int32)+import     Test.QuickCheck ((===))++type     N = D8+type     VectorN = LLVM.Vector N++test :: DocTest.T ()+test = do+ DocTest.printPrefix "LLVM.DSL.Expression.Vector:109: "+{-# LINE 109 "src/LLVM/DSL/Expression/Vector.hs" #-}+ DocTest.example(+{-# LINE 109 "src/LLVM/DSL/Expression/Vector.hs" #-}+    run Vector.replicate 42 :: LLVM.Vector D4 Int32+  )+  [ExpectedLine [LineChunk "Vector [42,42,42,42]"]]+ DocTest.printPrefix "LLVM.DSL.Expression.Vector:118: "+{-# LINE 118 "src/LLVM/DSL/Expression/Vector.hs" #-}+ DocTest.example(+{-# LINE 118 "src/LLVM/DSL/Expression/Vector.hs" #-}+    run (Expr.uncurry3 Vector.replicateSegmented) (LLVM.consVector False False True False False True False False, 8, LLVM.consVector 7 6 5 4 3 2 1 0) :: LLVM.Vector D8 Int32+  )+  [ExpectedLine [LineChunk "Vector [8,8,5,5,5,2,2,2]"]]+ DocTest.printPrefix "LLVM.DSL.Expression.Vector:121: "+{-# LINE 121 "src/LLVM/DSL/Expression/Vector.hs" #-}+ DocTest.property(+{-# LINE 121 "src/LLVM/DSL/Expression/Vector.hs" #-}+        +   sharedRun (Expr.uncurry3 Vector.replicateSegmented) $ \replicateSegmented ->+   \bs x xs ->+      NonEmpty.tail+         (NonEmpty.scanl (\lastX (b,xi) -> if b then xi else lastX)+            x (liftA2 (,) bs xs))+      ===+      replicateSegmented (bs, x, xs :: VectorN Int32)+  )+ DocTest.printPrefix "LLVM.DSL.Expression.Vector:138: "+{-# LINE 138 "src/LLVM/DSL/Expression/Vector.hs" #-}+ DocTest.example(+{-# LINE 138 "src/LLVM/DSL/Expression/Vector.hs" #-}+    run (Vector.iterate (6+)) 0 :: LLVM.Vector D8 Int32+  )+  [ExpectedLine [LineChunk "Vector [0,6,12,18,24,30,36,42]"]]+ DocTest.printPrefix "LLVM.DSL.Expression.Vector:141: "+{-# LINE 141 "src/LLVM/DSL/Expression/Vector.hs" #-}+ DocTest.property(+{-# LINE 141 "src/LLVM/DSL/Expression/Vector.hs" #-}+        +   sharedRun (Expr.uncurry (\d -> Vector.iterate (d+))) $ \iter ->+   \d x ->+      List.take 8 (List.iterate (d+) x)+      ===+      Fold.toList (iter (d,x) :: LLVM.Vector D8 Int32)+  )+ DocTest.printPrefix "LLVM.DSL.Expression.Vector:178: "+{-# LINE 178 "src/LLVM/DSL/Expression/Vector.hs" #-}+ DocTest.example(+{-# LINE 178 "src/LLVM/DSL/Expression/Vector.hs" #-}+    run (Expr.uncurry Vector.cumulateJoint) (3, LLVM.consVector 1 4 1 5 :: LLVM.Vector D4 Int32)+  )+  [ExpectedLine [LineChunk "(14,Vector [3,4,8,9])"]]+ DocTest.printPrefix "LLVM.DSL.Expression.Vector:181: "+{-# LINE 181 "src/LLVM/DSL/Expression/Vector.hs" #-}+ DocTest.property(+{-# LINE 181 "src/LLVM/DSL/Expression/Vector.hs" #-}+        +   sharedRun (Expr.uncurry Vector.cumulateJoint) $ \cumulateJoint ->+   \x xs ->+      Tuple.swap (NonEmpty.viewR (NonEmpty.scanl (+) x xs))+      ===+      cumulateJoint (x, xs :: VectorN Int32)+  )+ DocTest.printPrefix "LLVM.DSL.Expression.Vector:201: "+{-# LINE 201 "src/LLVM/DSL/Expression/Vector.hs" #-}+ DocTest.example(+{-# LINE 201 "src/LLVM/DSL/Expression/Vector.hs" #-}+    run Vector.cumulate1 (LLVM.consVector 3 1 4 1 :: LLVM.Vector D4 Int32)+  )+  [ExpectedLine [LineChunk "Vector [3,4,8,9]"]]+ DocTest.printPrefix "LLVM.DSL.Expression.Vector:204: "+{-# LINE 204 "src/LLVM/DSL/Expression/Vector.hs" #-}+ DocTest.example(+{-# LINE 204 "src/LLVM/DSL/Expression/Vector.hs" #-}+    run Vector.cumulate1 (LLVM.consVector 3 1 4 1 5 9 2 6 :: LLVM.Vector D8 Int32)+  )+  [ExpectedLine [LineChunk "Vector [3,4,8,9,14,23,25,31]"]]+ DocTest.printPrefix "LLVM.DSL.Expression.Vector:207: "+{-# LINE 207 "src/LLVM/DSL/Expression/Vector.hs" #-}+ DocTest.example(+{-# LINE 207 "src/LLVM/DSL/Expression/Vector.hs" #-}+    run Vector.cumulate1 (LLVM.consVector 0 0 1 0 0 (-1) 0 0 :: LLVM.Vector D8 Int32)+  )+  [ExpectedLine [LineChunk "Vector [0,0,1,1,1,0,0,0]"]]+ DocTest.printPrefix "LLVM.DSL.Expression.Vector:210: "+{-# LINE 210 "src/LLVM/DSL/Expression/Vector.hs" #-}+ DocTest.property(+{-# LINE 210 "src/LLVM/DSL/Expression/Vector.hs" #-}+        +   sharedRun Vector.cumulate1 $ \cumulate1 ->+   \x ->+      scanl1 (+) (Fold.toList x)+      ===+      Fold.toList (cumulate1 (x :: VectorN Int32))+  )+ DocTest.printPrefix "LLVM.DSL.Expression.Vector:218: "+{-# LINE 218 "src/LLVM/DSL/Expression/Vector.hs" #-}+ DocTest.property(+{-# LINE 218 "src/LLVM/DSL/Expression/Vector.hs" #-}+        +   sharedRun Vector.cumulate1 $ \cumulate1 ->+   \x ->+      NonEmpty.tail (NonEmpty.scanl (+) 0 x)+      ===+      cumulate1 (x :: VectorN Int32)+  )+ DocTest.printPrefix "LLVM.DSL.Expression.Vector:242: "+{-# LINE 242 "src/LLVM/DSL/Expression/Vector.hs" #-}+ DocTest.example(+{-# LINE 242 "src/LLVM/DSL/Expression/Vector.hs" #-}+    run (Expr.uncurry3 Vector.cumulateSegmentedJoint) (LLVM.consVector False False True False False True False False, 3, LLVM.consVector 1 4 1 5 9 2 6 5) :: (Int32, LLVM.Vector D8 Int32)+  )+  [ExpectedLine [LineChunk "(13,Vector [3,4,0,1,6,0,2,8])"]]+ DocTest.printPrefix "LLVM.DSL.Expression.Vector:245: "+{-# LINE 245 "src/LLVM/DSL/Expression/Vector.hs" #-}+ DocTest.property(+{-# LINE 245 "src/LLVM/DSL/Expression/Vector.hs" #-}+        +   sharedRun (Expr.uncurry3 Vector.cumulateSegmentedJoint) $+   \cumulateSegmentedJoint ->+   \bs x xs ->+      Trav.mapAccumL+         (\acc (b,xi) ->+            let yi = if b then 0 else acc in (yi+xi, yi))+         x (liftA2 (,) bs xs)+      ===+      cumulateSegmentedJoint (bs, x, xs :: VectorN Int32)+  )

@@ -1,5 +1,6 @@ module Main where +import qualified DocTest.LLVM.DSL.Expression.Vector as Vector import qualified Test.LLVM.DSL.Example.Median as Median import qualified LLVM.Core as LLVM @@ -9,4 +10,4 @@ main :: IO () main = do    LLVM.initializeNativeTarget-   DocTest.run Median.run+   DocTest.run $ Vector.test >> Median.run

@@ -0,0 +1,49 @@+{-# LANGUAGE ForeignFunctionInterface #-}+module Test.LLVM.DSL.Run where++import qualified Test.QuickCheck as QC++import qualified LLVM.DSL.Execution as Exec+import qualified LLVM.DSL.Expression as Expr+import LLVM.DSL.Expression (Exp)++import qualified LLVM.Extra.Nice.Value.Marshal as Marshal+import qualified LLVM.Extra.Memory as Memory+import qualified LLVM.Core as LLVM++import System.IO.Unsafe (unsafePerformIO)+++foreign import ccall safe "dynamic" derefFuncPtr ::+   Exec.Importer (LLVM.Ptr inp -> LLVM.Ptr out -> IO ())+++sharedRun ::+   (QC.Testable prop, Marshal.C a, Marshal.C b) =>+   (Expr.Exp a -> Expr.Exp b) -> ((a -> b) -> prop) -> QC.Property+sharedRun f prop =+   QC.idempotentIOProperty $ do+      code <- runIO f+      return $ QC.forAllBlind (return code) prop++run ::+   (Marshal.C a, Marshal.C b) =>+   (Exp a -> Exp b) ->+   a -> b+run = unsafePerformIO . runIO++runIO ::+   (Marshal.C a, Marshal.C b) =>+   (Exp a -> Exp b) ->+   IO (a -> b)+runIO f = do+   code <-+      Exec.compile "doctest" $+      Exec.createFunction derefFuncPtr "func" $ \aPtr bPtr ->+         flip Memory.store bPtr =<< Expr.unliftM1 f =<< Memory.load aPtr++   return $ \a ->+      unsafePerformIO $+      Marshal.alloca $ \bPtr ->+      Marshal.with a $ \aPtr ->+      code aPtr bPtr >> Marshal.peek bPtr