Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

[WIP] Efficient storage of sum data types #522

Open
wants to merge 67 commits into
base: master
Choose a base branch
from
Open
Show file tree
Hide file tree
Changes from 1 commit
Commits
Show all changes
67 commits
Select commit Hold shift + click to select a range
26798bd
link posable library
Riscky Feb 23, 2022
d46f7c7
POS instances for primary types, Vec
Riscky Feb 24, 2022
078d4f0
emptyFields implementation for Vec
Riscky Feb 24, 2022
a327abe
Redefine Elt for Shapes
Riscky Feb 24, 2022
7d24117
actually fill array in replicateVecN
Riscky Feb 24, 2022
df2ecff
Array with Elt'
Riscky Feb 25, 2022
99f482b
don't import Type from POS
Riscky Mar 1, 2022
8476596
convert typelists to tuples
Riscky Mar 1, 2022
d994fdd
Convert POS to EltR
Riscky Mar 2, 2022
27eac67
integrate Elt and POS?
Riscky Mar 2, 2022
3080b14
sorta kinda integrated POS into shapes
Riscky Mar 2, 2022
b878ec6
Slices understand SingletonTypes now
Riscky Mar 3, 2022
a1e1497
shapes with singletontypes
Riscky Mar 3, 2022
1e4a1f5
shape sugar with singletontypes
Riscky Mar 3, 2022
c66b0f7
more array with singletontypes
Riscky Mar 3, 2022
88401e1
reverted elt' change
Riscky Mar 3, 2022
fdca1a2
AST understands POS
Riscky Mar 4, 2022
bce5173
AST understands POS
Riscky Mar 8, 2022
238551f
stencil
Riscky Mar 8, 2022
05b4ade
Make Singletontypes behave as original
Riscky Mar 8, 2022
f714a7d
revert shape, slice singletons
Riscky Mar 8, 2022
ae5f19f
revert sugar shape singleton
Riscky Mar 8, 2022
fd1398f
revert stencil singletontype
Riscky Mar 8, 2022
996ad1b
revert singletontype completely
Riscky Mar 8, 2022
e1e00f7
create groundtypes with POSable instance via TH
Riscky Mar 10, 2022
520adc6
default definition for eltR, including ugly hacks
Riscky Mar 11, 2022
df1fd12
add OuterChoices / outerChoice to POS instances
Riscky Mar 29, 2022
c299d35
remove unused stuff from Representation/POS
Riscky Mar 29, 2022
fac73b7
convert Sums to tuple representation
Riscky Apr 7, 2022
b8d1fa0
pretty print POS structures
Riscky Apr 7, 2022
ead51a2
IsScalar instances for SumScalarType
Riscky Apr 7, 2022
8f825d3
build Maybe in Matchable
Riscky Apr 7, 2022
e13bed1
compiling Maybe Int pattern match
Riscky Apr 7, 2022
09447f7
build TAG
Riscky Apr 8, 2022
6bce206
split EltR with helper function
Riscky Apr 12, 2022
a353044
simplify SumScalarType
Riscky Apr 12, 2022
3314491
more stuff for Matchable
Riscky Apr 12, 2022
0f6cf5b
simpler union operators
Riscky Apr 14, 2022
26b41c8
new union ast constructors
Riscky May 17, 2022
5caac30
only allow singleTypes in sums
Riscky May 17, 2022
2b9a753
rename sumscalar to unionscalar
Riscky May 17, 2022
79fed72
rewrote Matchable without POSable references
Riscky May 19, 2022
da6380e
index operator with beauty notation
Riscky May 20, 2022
02bf6cb
removed outerchoices
Riscky May 20, 2022
5d05a98
more Either build AST
Riscky May 20, 2022
912b66c
cleanup Matchable
Riscky Jun 1, 2022
b17614c
makeLeft works :O
Riscky Jun 1, 2022
25bbffb
more Maybe build
Riscky Jun 2, 2022
7a52b2c
build implemented for Maybe a
Riscky Jun 2, 2022
e183544
match on maybe
Riscky Jun 2, 2022
7f1a7bc
Matchable instance for polymorphic Either
Riscky Jun 2, 2022
15716b7
tag building in terms of tagVal
Riscky Jun 2, 2022
24d2458
pattern matching up to pattern synonyms
Riscky Jun 3, 2022
28fc675
Patterns for Maybe
Riscky Jun 3, 2022
a9b4d34
pattern synonyms for Either and Bool
Riscky Jun 3, 2022
908f47a
make integer synonyms Ground and POSable
Riscky Jun 3, 2022
ff615b9
correct definition of mkEltR and fromEltR
Riscky Jun 22, 2022
6fe8dd3
define mkEltRT in terms of eltRType
Riscky Jun 23, 2022
1930f77
simplify scalarTypeTAGg
Riscky Jun 23, 2022
f845bd2
replace mkMin by correct mkSub
Riscky Jun 23, 2022
781ac2d
use type lists for unionscalars
Riscky Jun 24, 2022
dc522ea
use posable from hackage
Riscky Jun 30, 2022
a338b9f
update version ranges to match posable
Riscky Jun 30, 2022
52a8621
remove unused PrimShiftFinite operator
Riscky Jun 30, 2022
b974e62
revert unchanged file
Riscky Jun 30, 2022
12fa79a
bit of cleanup
Riscky Jun 30, 2022
e2dcdac
remove unused imports
Riscky Jun 30, 2022
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
Prev Previous commit
Next Next commit
AST understands POS
  • Loading branch information
Riscky committed Jun 30, 2022
commit fdca1a24f0ef99564bd5a4b0ef8924ce919e3b50
29 changes: 17 additions & 12 deletions src/Data/Array/Accelerate/AST.hs
Original file line number Diff line number Diff line change
Expand Up @@ -9,6 +9,8 @@
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE DataKinds #-}
{-# OPTIONS_HADDOCK hide #-}
-- |
-- Module : Data.Array.Accelerate.AST
Expand Down Expand Up @@ -146,6 +148,7 @@ import Data.Array.Accelerate.Representation.Tag
import Data.Array.Accelerate.Representation.Type
import Data.Array.Accelerate.Representation.Vec
import Data.Array.Accelerate.Sugar.Foreign
import Data.Array.Accelerate.Sugar.Elt
import Data.Array.Accelerate.Type
import Data.Primitive.Vec

Expand Down Expand Up @@ -198,9 +201,8 @@ type ArrayVar = Var ArrayR
type ArrayVars aenv = Vars ArrayR aenv

-- Bool is not a primitive type
type PrimBool = TAG
type PrimMaybe a = (TAG, ((), a))

type PrimBool = EltR Bool
type PrimMaybe a = EltR (Maybe a)
-- Trace messages
data Message a where
Message :: (a -> String) -- embedded show
Expand Down Expand Up @@ -681,13 +683,13 @@ data PrimFun sig where
PrimBOr :: IntegralType a -> PrimFun ((a, a) -> a)
PrimBXor :: IntegralType a -> PrimFun ((a, a) -> a)
PrimBNot :: IntegralType a -> PrimFun (a -> a)
PrimBShiftL :: IntegralType a -> PrimFun ((a, Int) -> a)
PrimBShiftR :: IntegralType a -> PrimFun ((a, Int) -> a)
PrimBRotateL :: IntegralType a -> PrimFun ((a, Int) -> a)
PrimBRotateR :: IntegralType a -> PrimFun ((a, Int) -> a)
PrimPopCount :: IntegralType a -> PrimFun (a -> Int)
PrimCountLeadingZeros :: IntegralType a -> PrimFun (a -> Int)
PrimCountTrailingZeros :: IntegralType a -> PrimFun (a -> Int)
PrimBShiftL :: IntegralType a -> PrimFun ((a, SingletonType Int) -> a)
PrimBShiftR :: IntegralType a -> PrimFun ((a, SingletonType Int) -> a)
PrimBRotateL :: IntegralType a -> PrimFun ((a, SingletonType Int) -> a)
PrimBRotateR :: IntegralType a -> PrimFun ((a, SingletonType Int) -> a)
PrimPopCount :: IntegralType a -> PrimFun (a -> SingletonType Int)
PrimCountLeadingZeros :: IntegralType a -> PrimFun (a -> SingletonType Int)
PrimCountTrailingZeros :: IntegralType a -> PrimFun (a -> SingletonType Int)

-- operators from Fractional and Floating
PrimFDiv :: FloatingType a -> PrimFun ((a, a) -> a)
Expand Down Expand Up @@ -940,8 +942,11 @@ primFunType = \case
integral = num . IntegralNumType
floating = num . FloatingNumType

tbool = TupRsingle scalarTypeWord8
tint = TupRsingle scalarTypeInt
tbool :: TypeR PrimBool
tbool = TupRpair (TupRsingle (TagScalarType @2 0)) TupRunit

tint :: TypeR (SingletonType Int)
tint = TupRsingle (SingleScalarType (NumSingleType (IntegralNumType TypeSingletonType)))


-- Normal form data
Expand Down
22 changes: 13 additions & 9 deletions src/Data/Array/Accelerate/Representation/Stencil.hs
Original file line number Diff line number Diff line change
@@ -1,5 +1,6 @@
{-# LANGUAGE GADTs #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-}
{-# OPTIONS_HADDOCK hide #-}
-- |
-- Module : Data.Array.Accelerate.Representation.Stencil
Expand All @@ -25,6 +26,9 @@ module Data.Array.Accelerate.Representation.Stencil (
import Data.Array.Accelerate.Representation.Array
import Data.Array.Accelerate.Representation.Shape
import Data.Array.Accelerate.Representation.Type
import Data.Array.Accelerate.Representation.Elt
import Data.Array.Accelerate.Sugar.Elt
import Data.Array.Accelerate.Type

import Language.Haskell.TH.Extra

Expand All @@ -40,14 +44,14 @@ data StencilR sh e pat where
StencilRtup3 :: StencilR sh e pat1
-> StencilR sh e pat2
-> StencilR sh e pat3
-> StencilR (sh, Int) e (Tup3 pat1 pat2 pat3)
-> StencilR (sh, SingletonType Int) e (Tup3 pat1 pat2 pat3)

StencilRtup5 :: StencilR sh e pat1
-> StencilR sh e pat2
-> StencilR sh e pat3
-> StencilR sh e pat4
-> StencilR sh e pat5
-> StencilR (sh, Int) e (Tup5 pat1 pat2 pat3 pat4 pat5)
-> StencilR (sh, SingletonType Int) e (Tup5 pat1 pat2 pat3 pat4 pat5)

StencilRtup7 :: StencilR sh e pat1
-> StencilR sh e pat2
Expand All @@ -56,7 +60,7 @@ data StencilR sh e pat where
-> StencilR sh e pat5
-> StencilR sh e pat6
-> StencilR sh e pat7
-> StencilR (sh, Int) e (Tup7 pat1 pat2 pat3 pat4 pat5 pat6 pat7)
-> StencilR (sh, SingletonType Int) e (Tup7 pat1 pat2 pat3 pat4 pat5 pat6 pat7)

StencilRtup9 :: StencilR sh e pat1
-> StencilR sh e pat2
Expand All @@ -67,7 +71,7 @@ data StencilR sh e pat where
-> StencilR sh e pat7
-> StencilR sh e pat8
-> StencilR sh e pat9
-> StencilR (sh, Int) e (Tup9 pat1 pat2 pat3 pat4 pat5 pat6 pat7 pat8 pat9)
-> StencilR (sh, SingletonType Int) e (Tup9 pat1 pat2 pat3 pat4 pat5 pat6 pat7 pat8 pat9)

stencilEltR :: StencilR sh e pat -> TypeR e
stencilEltR (StencilRunit3 t) = t
Expand Down Expand Up @@ -111,19 +115,19 @@ stencilHalo = go'
go' StencilRunit7{} = (dim1, ((), 3))
go' StencilRunit9{} = (dim1, ((), 4))
--
go' (StencilRtup3 a b c ) = (ShapeRsnoc shR, cons shR 1 $ foldl1 (union shR) [a', go b, go c])
go' (StencilRtup3 a b c ) = (ShapeRsnoc shR, cons shR (fromElt @Int 1) $ foldl1 (union shR) [a', go b, go c])
where (shR, a') = go' a
go' (StencilRtup5 a b c d e ) = (ShapeRsnoc shR, cons shR 2 $ foldl1 (union shR) [a', go b, go c, go d, go e])
go' (StencilRtup5 a b c d e ) = (ShapeRsnoc shR, cons shR (fromElt @Int 2) $ foldl1 (union shR) [a', go b, go c, go d, go e])
where (shR, a') = go' a
go' (StencilRtup7 a b c d e f g ) = (ShapeRsnoc shR, cons shR 3 $ foldl1 (union shR) [a', go b, go c, go d, go e, go f, go g])
go' (StencilRtup7 a b c d e f g ) = (ShapeRsnoc shR, cons shR (fromElt @Int 3) $ foldl1 (union shR) [a', go b, go c, go d, go e, go f, go g])
where (shR, a') = go' a
go' (StencilRtup9 a b c d e f g h i) = (ShapeRsnoc shR, cons shR 4 $ foldl1 (union shR) [a', go b, go c, go d, go e, go f, go g, go h, go i])
go' (StencilRtup9 a b c d e f g h i) = (ShapeRsnoc shR, cons shR (fromElt @Int 4) $ foldl1 (union shR) [a', go b, go c, go d, go e, go f, go g, go h, go i])
where (shR, a') = go' a

go :: StencilR sh e stencil -> sh
go = snd . go'

cons :: ShapeR sh -> Int -> sh -> (sh, Int)
cons :: ShapeR sh -> SingletonType Int -> sh -> (sh, SingletonType Int)
cons ShapeRz ix () = ((), ix)
cons (ShapeRsnoc shr) ix (sh, sz) = (cons shr ix sh, sz)

Expand Down
18 changes: 5 additions & 13 deletions src/Data/Array/Accelerate/Smart.hs
Original file line number Diff line number Diff line change
Expand Up @@ -1156,21 +1156,13 @@ mkMin = mkPrimBinary $ PrimMin singleType
-- Logical operators

mkLAnd :: Exp Bool -> Exp Bool -> Exp Bool
mkLAnd (Exp a) (Exp b) = mkExp $ SmartExp (PrimApp PrimLAnd (SmartExp $ Pair x y)) `Pair` SmartExp Nil
where
x = SmartExp $ Prj PairIdxLeft a
y = SmartExp $ Prj PairIdxLeft b
mkLAnd (Exp a) (Exp b) = mkExp $ PrimApp PrimLAnd (SmartExp $ Pair a b)

mkLOr :: Exp Bool -> Exp Bool -> Exp Bool
mkLOr (Exp a) (Exp b) = mkExp $ SmartExp (PrimApp PrimLOr (SmartExp $ Pair x y)) `Pair` SmartExp Nil
where
x = SmartExp $ Prj PairIdxLeft a
y = SmartExp $ Prj PairIdxLeft b
mkLOr (Exp a) (Exp b) = mkExp $ PrimApp PrimLOr (SmartExp $ Pair a b)

mkLNot :: Exp Bool -> Exp Bool
mkLNot (Exp a) = mkExp $ SmartExp (PrimApp PrimLNot x) `Pair` SmartExp Nil
where
x = SmartExp $ Prj PairIdxLeft a
mkLNot (Exp a) = mkExp $ PrimApp PrimLNot a

-- Numeric conversions

Expand Down Expand Up @@ -1260,10 +1252,10 @@ mkPrimBinary :: (Elt a, Elt b, Elt c) => PrimFun ((EltR a, EltR b) -> EltR c) ->
mkPrimBinary prim (Exp a) (Exp b) = mkExp $ PrimApp prim (SmartExp $ Pair a b)

mkPrimUnaryBool :: Elt a => PrimFun (EltR a -> PrimBool) -> Exp a -> Exp Bool
mkPrimUnaryBool = mkCoerce @PrimBool $$ mkPrimUnary
mkPrimUnaryBool = mkCoerce @Bool $$ mkPrimUnary

mkPrimBinaryBool :: (Elt a, Elt b) => PrimFun ((EltR a, EltR b) -> PrimBool) -> Exp a -> Exp b -> Exp Bool
mkPrimBinaryBool = mkCoerce @PrimBool $$$ mkPrimBinary
mkPrimBinaryBool = mkCoerce @Bool $$$ mkPrimBinary

unPair :: SmartExp (a, b) -> (SmartExp a, SmartExp b)
unPair e = (SmartExp $ Prj PairIdxLeft e, SmartExp $ Prj PairIdxRight e)
Expand Down
2 changes: 2 additions & 0 deletions src/Data/Array/Accelerate/Type.hs
Original file line number Diff line number Diff line change
Expand Up @@ -169,6 +169,7 @@ data IntegralType a where
TypeWord32 :: IntegralType Word32
TypeWord64 :: IntegralType Word64
TypeSingletonType :: IntegralType (SingletonType a)
TypeTAG :: IntegralType (Finite n)


type SingletonType x = (ScalarType (Int, ()), ())
Expand All @@ -195,6 +196,7 @@ data BoundedType a where
--
data ScalarType a where
SumScalarType :: Sum a -> ScalarType (FlattenSum a)
TagScalarType :: Finite n -> ScalarType (Finite n)
SingleScalarType :: SingleType a -> ScalarType a
VectorScalarType :: VectorType (Vec n a) -> ScalarType (Vec n a)

Expand Down