blob: ed307c0649812b4a1373c6bd0a26aaec75f5d3c6 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
|
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
module Interpreter.Rep where
import Data.IORef
import GHC.TypeError
import Array
import AST
type family Rep t where
Rep TNil = ()
Rep (TPair a b) = (Rep a, Rep b)
Rep (TEither a b) = Either (Rep a) (Rep b)
Rep (TMaybe t) = Maybe (Rep t)
Rep (TArr n t) = Array n (Rep t)
Rep (TScal sty) = ScalRep sty
Rep (TAccum t) = RepAcSparse t
-- Mutable, and has a zero. The zero may not be O(1), but RepAcSparse (D2 t) will have an O(1) zero.
type family RepAcSparse t where
RepAcSparse TNil = ()
RepAcSparse (TPair a b) = IORef (RepAcSparse a, RepAcSparse b)
RepAcSparse (TEither a b) = TypeError (Text "Non-sparse coproduct is not a monoid")
RepAcSparse (TMaybe t) = IORef (Maybe (RepAcDense t)) -- allow the value to be dense, because the Maybe's zero can be used for the contents
RepAcSparse (TArr n t) = IORef (Array n (RepAcSparse t)) -- empty array is zero
RepAcSparse (TScal sty) = IORef (ScalRep sty)
RepAcSparse (TAccum t) = TypeError (Text "RepAcSparse: Nested accumulators")
-- Immutable, and does not necessarily have a zero.
type family RepAcDense t where
RepAcDense TNil = ()
-- RepAcDense (TPair a b) = (RepAcSparse a, RepAcSparse b)
RepAcDense (TEither a b) = Either (RepAcSparse a) (RepAcSparse b)
-- RepAcDense (TMaybe t) = RepAcSparse (TMaybe t) -- ^ This can be optimised to TMaybe (RepAcSparse t), but that makes accumAddDense very hard to write. And in any case, we don't need it because D2 will not produce Maybe of Maybe.
-- RepAcDense (TArr n t) = Array n (RepAcSparse t)
-- RepAcDense (TScal sty) = ScalRep sty
-- RepAcDense (TAccum t) = TypeError (Text "RepAcDense: Nested accumulators")
newtype Value t = Value { unValue :: Rep t }
liftV :: (Rep a -> Rep b) -> Value a -> Value b
liftV f (Value x) = Value (f x)
liftV2 :: (Rep a -> Rep b -> Rep c) -> Value a -> Value b -> Value c
liftV2 f (Value x) (Value y) = Value (f x y)
vPair :: Value a -> Value b -> Value (TPair a b)
vPair = liftV2 (,)
vUnpair :: Value (TPair a b) -> (Value a, Value b)
vUnpair (Value (x, y)) = (Value x, Value y)
|
