git.iko.soy/project-m36
on master help sign in
WIP compilation checkpoint
4a3c45fAgentM
src/lib/ProjectM36/ConstructedAtom.hs+41−20
compare with master
unifiedsplit
@@ -6,15 +6,17 @@ import ProjectM36.Base
6import GHC.Generics
6import GHC.Generics
7import qualified Data.Text as T
7import qualified Data.Text as T
8import qualified Data.Map as M
8import qualified Data.Map as M
9−import Data.Typeable
9+--import Data.Typeable
10+--import Debug.Trace
10
11
11data TestT = TestC Int
12data TestT = TestC Int
12− deriving Generic
13+ deriving (Generic, Show)
13
14
14data Test2T x = Test2C x
15data Test2T x = Test2C x
15− deriving Generic
16+ deriving (Show, Generic)
16
17
17instance Atomable TestT
18instance Atomable TestT
19+instance Atomable a => Atomable (Test2T a)
18
20
19class Atomable a where
21class Atomable a where
20 --type AtomT a
22 --type AtomT a
@@ -30,44 +32,63 @@ instance Atomable Int where
30 toAtom i = IntAtom i
32 toAtom i = IntAtom i
31 toAtomType _ = IntAtomType
33 toAtomType _ = IntAtomType
32
34
35+instance Atomable Text where
36+ toAtom i = TextAtom i
37+ toAtomType _ = TextAtomType
38+
33-- Generics
39-- Generics
34class AtomableG g where
40class AtomableG g where
35 --type AtomTG g
41 --type AtomTG g
36 toAtomG :: g a -> Atom
42 toAtomG :: g a -> Atom
37− toAtomTypeG :: g a -> AtomType
43+ toAtomTypeG :: g a -> AtomType --overall ConstructedAtomType
38−
44+ toAtomTypesG :: g a -> [AtomType] --built from individual atom types
39−class TypeVarMappableG g where
40− toTypeVarMap :: g a -> TypeVarMap
41
45
46+{-
42instance (AtomableG a, AtomableG b) => AtomableG (a :*: b) where
47instance (AtomableG a, AtomableG b) => AtomableG (a :*: b) where
43 --type AtomTG (a :*: b) = (AtomTG a, AtomTG b)
48 --type AtomTG (a :*: b) = (AtomTG a, AtomTG b)
44 toAtomG v = undefined
49 toAtomG v = undefined
45 toAtomTypeG v = undefined
50 toAtomTypeG v = undefined
46−
51+-}
52+-- Right | Left
53+ {-
47−instance (AtomableG a, AtomableG b) => AtomableG (a :+: b) where
54+instance (AtomableG (a p), AtomableG (b p)) => AtomableG ((a :+: b) p) where
48 --type AtomTG (a :+: b) = (AtomTG a, AtomTG b)
55 --type AtomTG (a :+: b) = (AtomTG a, AtomTG b)
49 toAtomG v = undefined
56 toAtomG v = undefined
50 toAtomTypeG v = undefined
57 toAtomTypeG v = undefined
51
58
59+-- Test Int Int
60+instance (Atomable (a p), Atomable (b p)) => AtomableG ((a :*: b) p) where
61+ toAtomG = undefined
62+ toAtomTypeG (x :*: y) = undefined
63+-}
64+
52--data type metadata
65--data type metadata
53−instance (Datatype c, TypeVarMappableG a) => AtomableG (M1 D c a) where
66+instance (Datatype c, AtomableG a) => AtomableG (M1 D c a) where
54 --type AtomTG (M1 D c a) = AtomTG a
67 --type AtomTG (M1 D c a) = AtomTG a
55 toAtomG = undefined
68 toAtomG = undefined
69+ toAtomTypesG = undefined
56 toAtomTypeG (M1 v) = ConstructedAtomType (T.pack typeName) tvMap
70 toAtomTypeG (M1 v) = ConstructedAtomType (T.pack typeName) tvMap
57 where
71 where
72+ aTypes = toAtomTypesG v
73+ a2z = map T.singleton ['a'..'z']
74+ tvMap = M.fromList (zip a2z aTypes)
58 typeName = datatypeName (undefined :: M1 D c a x)
75 typeName = datatypeName (undefined :: M1 D c a x)
59− tvMap = toTypeVarMap v
76+
60−
77+
61−instance TypeVarMappableG (M1 C c a) where
78+instance (Constructor c, AtomableG a) => AtomableG (M1 C c a) where
62 --M.Map TypeVarName AtomType
79 --M.Map TypeVarName AtomType
63− toTypeVarMap (M1 v) = M.empty
80+ --constructor name needed for Atom but not for atomType
64−
81+ toAtomG (M1 _) = ConstructedAtom (T.pack constructorName) AnyAtomType []
65−{-
82+ where
83+ constructorName = conName (undefined :: M1 C c a x)
84+ toAtomTypeG = undefined
85+ toAtomTypesG (M1 v) = toAtomTypesG v
86+
66−instance Atomable c => AtomableG (M1 S c (Rec0 f)) where
87+instance Atomable f => AtomableG (M1 S c (Rec0 f)) where
67 toAtomG = undefined
88 toAtomG = undefined
68− toAtomTypeG (M1 v) = toAtomType v
89+ toAtomTypeG = undefined
69−
90+ toAtomTypesG _ = [toAtomType (undefined :: f)]
70−-}
91+
71{-
92{-
72--constructor metadata
93--constructor metadata
73instance AtomableG a => AtomableG (M1 C c a) where
94instance AtomableG a => AtomableG (M1 C c a) where