319eca7 · project-m36 · git.iko.soy

git.iko.soy/project-m36

non-compiling WIP

I need to think more about what conditions are allowable for thunking expressions The processThunks function may not make sense outside the context of the eval function since each case is so different

commit319eca75c33d3e211a11dfb97eb16126ba6256ba authorAgentM <agentm@themactionfaction.com> dateThu 9 Mar 2017, 21:14 (10 years ago) parent935e8c2

11 files changed+104−56

compare with master

unifiedsplit

src/lib/ProjectM36/Base.hs+13−19 src/lib/ProjectM36/Client.hs+3−2 src/lib/ProjectM36/DatabaseContext.hs+6 src/lib/ProjectM36/DatabaseContextExpression.hs+4−22 src/lib/ProjectM36/DatabaseContextState.hs+29 src/lib/ProjectM36/IsomorphicSchema.hs+1 src/lib/ProjectM36/LazyDatabaseContextExpression.hs+43 src/lib/ProjectM36/StaticOptimizer/DatabaseContextExpression.hs+1 src/lib/ProjectM36/TransGraphRelationalExpression.hs−11 src/lib/ProjectM36/Transaction/Persist.hs+3−1 src/lib/ProjectM36/TransactionGraph.hs+1−1

src/lib/ProjectM36/Base.hs+13−19

@@ -153,7 +153,8 @@ instance Eq RelationTuple where

153153

154154instance NFData RelationTuple where rnf = genericRnf

155155

156−data Relation = Relation Attributes RelationTupleSet deriving (Show, Generic,Typeable)

156+data Relation = Relation Attributes RelationTupleSet

157+ deriving (Show, Generic,Typeable)

157158

158159instance Eq Relation where

159160 Relation attrs1 tupSet1 == Relation attrs2 tupSet2 = attributesEqual attrs1 attrs2 && tupSet1 == tupSet2

@@ -188,6 +189,7 @@ data RelationalExprBase a =

188189 --in Tutorial D, relational variables pick up the type of the first relation assigned to them

189190 --relational variables should also be able to be explicitly-typed like in Haskell

190191 --- | Reference a relation variable by its name.

192+ -- this relies on access to the database context without altering the context, so should there be another type of expression? RODatabaseContextExpr? That would allow the RelationalExprs to be evaluated without ANY state needed

191193 RelationVariable RelVarName a |

192194 --- | Create a projection over attribute names. (Note that the 'AttributeNames' structure allows for the names to be inverted.)

193195 Project AttributeNames (RelationalExprBase a) |

@@ -210,10 +212,8 @@ data RelationalExprBase a =

210212 NotEquals (RelationalExprBase a) (RelationalExprBase a) |

211213 Extend (ExtendTupleExprBase a) (RelationalExprBase a)

212214 --Summarize :: AtomExpr -> AttributeName -> RelationalExpr -> RelationalExpr -> RelationalExpr -- a special case of Extend

213− deriving (Show, Eq, Generic)

215+ deriving (Show, Eq, Generic, NFData, Binary)

214216

215−instance Binary RelationalExpr

216−

217217type NotificationName = StringType

218218type Notifications = M.Map NotificationName Notification

219219

@@ -284,8 +284,10 @@ data DatabaseContext = DatabaseContext {

284284 relationVariables :: RelationVariables,

285285 atomFunctions :: AtomFunctions,

286286 notifications :: Notifications,

287− typeConstructorMapping :: TypeConstructorMapping

287+ typeConstructorMapping :: TypeConstructorMapping,

288+ thunks :: DatabaseContextExpr

288289 }

290+

289291

290292type IncDepName = StringType

291293

@@ -337,9 +339,7 @@ data RestrictionPredicateExprBase a =

337339 RelationalExprPredicate (RelationalExprBase a) | --type must be same as true and false relations (no attributes)

338340 AtomExprPredicate (AtomExprBase a) | --atom must evaluate to boolean

339341 AttributeEqualityPredicate AttributeName (AtomExprBase a) -- relationalexpr must result in relation with single tuple

340− deriving (Show, Eq, Generic)

341−

342−instance Binary RestrictionPredicateExpr

342+ deriving (Show, Eq, Generic, NFData, Binary)

343343

344344-- child + parent links

345345-- | A transaction graph's head name references the leaves of the transaction graph and can be used during session creation to indicate at which point in the graph commits should persist.

@@ -393,18 +393,14 @@ data AtomExprBase a = AttributeAtomExpr AttributeName |

393393 FunctionAtomExpr AtomFunctionName [AtomExprBase a] a |

394394 RelationAtomExpr (RelationalExprBase a) |

395395 ConstructedAtomExpr DataConstructorName [AtomExprBase a] a

396− deriving (Eq,Show,Generic)

396+ deriving (Eq, Show, Generic, NFData, Binary)

397397

398−instance Binary AtomExpr

399−

400398-- | Used in tuple creation when creating a relation.

401399data ExtendTupleExprBase a = AttributeExtendTupleExpr AttributeName (AtomExprBase a)

402− deriving (Show, Eq, Generic)

400+ deriving (Show, Eq, Generic, NFData, Binary)

403401

404402type ExtendTupleExpr = ExtendTupleExprBase ()

405403

406−instance Binary ExtendTupleExpr

407−

408404--enumerates the list of functions available to be run as part of tuple expressions

409405type AtomFunctions = HS.HashSet AtomFunction

410406

@@ -456,7 +452,7 @@ data AttributeNames = AttributeNames (S.Set AttributeName) |

456452 InvertedAttributeNames (S.Set AttributeName) |

457453 UnionAttributeNames AttributeNames AttributeNames |

458454 IntersectAttributeNames AttributeNames AttributeNames

459− deriving (Eq, Show, Generic)

455+ deriving (Eq, Show, Generic, NFData)

460456

461457instance Binary AttributeNames

462458

@@ -470,12 +466,10 @@ type AttributeExpr = AttributeExprBase ()

470466

471467data AttributeExprBase a = AttributeAndTypeNameExpr AttributeName TypeConstructor a |

472468 NakedAttributeExpr Attribute

473− deriving (Eq, Show, Generic, Binary)

469+ deriving (Eq, Show, Generic, Binary, NFData)

474470

475471data TupleExprBase a = TupleExpr (M.Map AttributeName (AtomExprBase a))

476− deriving (Eq, Show, Generic)

477−

478−instance Binary TupleExpr

472+ deriving (Eq, Show, Generic, NFData, Binary)

479473

480474type TupleExpr = TupleExprBase ()

481475

src/lib/ProjectM36/Client.hs+3−2

@@ -86,8 +86,9 @@ import qualified ProjectM36.RelationalExpression as RE

8686import qualified ProjectM36.RelationalExpressionState as RES

8787import ProjectM36.InclusionDependencyValidation

8888import qualified ProjectM36.DatabaseContextExpression as DCE

89−import ProjectM36.DatabaseContextExpression

89+import ProjectM36.DatabaseContextState

9090import ProjectM36.DatabaseContext (basicDatabaseContext)

91+import qualified ProjectM36.DatabaseContext as DC

9192import ProjectM36.TransactionGraph

9293import qualified ProjectM36.Transaction as Trans

9394import ProjectM36.TransactionGraph.Persist

@@ -637,7 +638,7 @@ executeTransGraphRelationalExpr _ (InProcessConnection conf) tgraphExpr = excEit

637638 graph <- readTVar graphTvar

638639 case evalTransGraphRelationalExpr tgraphExpr graph of

639640 Left err -> pure (Left err)

640− Right relExpr -> case evalState (RE.evalRelationalExpr relExpr) (RES.mkRelationalExprState DCE.emptyDatabaseContext) of

641+ Right relExpr -> case evalState (RE.evalRelationalExpr relExpr) (RES.mkRelationalExprState DC.empty) of

641642 Left err -> pure (Left err)

642643 Right rel -> pure (force (Right rel))

643644executeTransGraphRelationalExpr sessionId conn@(RemoteProcessConnection _) tgraphExpr = remoteCall conn (ExecuteTransGraphRelationalExpr sessionId tgraphExpr)

src/lib/ProjectM36/DatabaseContext.hs+6

@@ -38,3 +38,9 @@ contextWithEmptyTupleSets :: DatabaseContext -> DatabaseContext

3838contextWithEmptyTupleSets contextIn = contextIn { relationVariables = relVars }

3939 where

4040 relVars = M.map (\rel -> Relation (attributes rel) emptyTupleSet) (relationVariables contextIn)

41+

42+thunkless :: DatabaseContext -> Bool

43+thunkless context = case thunks context of

44+ NoOperation -> True

45+ MultipleExpr multi -> length (filter ((/=) NoOperation) multi) == 0

46+ _ -> False

src/lib/ProjectM36/DatabaseContextExpression.hs+4−22

@@ -2,6 +2,7 @@

22module ProjectM36.DatabaseContextExpression where

33import ProjectM36.RelationalExpression

44import ProjectM36.RelationalExpressionState

5+import ProjectM36.DatabaseContextState

56import ProjectM36.Relation

67import ProjectM36.Base

78import ProjectM36.Error

@@ -24,26 +25,7 @@ import Data.Maybe

2425import GHC

2526import GHC.Paths

2627

27−type ConstraintValidator = DatabaseContextExpr -> DatabaseContext -> Maybe RelationalError

28−

29−data DatabaseContextEvalState = DatabaseContextEvalState {

30− dbcontext :: DatabaseContext,

31− constraintValidator :: ConstraintValidator

32− }

33−

34−type DatabaseState a = State DatabaseContextEvalState a

35−

36−getDatabaseContext :: DatabaseState DatabaseContext

37−getDatabaseContext = liftM dbcontext get

38−

39−getConstraintValidator :: DatabaseState ConstraintValidator

40−getConstraintValidator = liftM constraintValidator get

41−

42−putDatabaseContext :: DatabaseContext -> DatabaseState ()

43−putDatabaseContext context = do

44− dbstate <- get

45− put (dbstate {dbcontext = context})

46−

28+{-

4729emptyDatabaseContext :: DatabaseContext

4830emptyDatabaseContext = DatabaseContext { inclusionDependencies = M.empty,

4931 relationVariables = M.empty,

@@ -51,8 +33,7 @@ emptyDatabaseContext = DatabaseContext { inclusionDependencies = M.empty,

5133 notifications = M.empty,

5234 typeConstructorMapping = []

5335 }

54−

55−

36+-}

5637

5738--helper function to process relation variable creation/assignment

5839--the dbcontextexpr is useful for optimizing the constraint validation

@@ -97,6 +78,7 @@ evalDatabaseContextExpr expr@(Define relVarName attrExprs) = do

9778 emptyRelation = Relation attrs emptyTupleSet

9879

9980evalDatabaseContextExpr expr@(Undefine relVarName) = do

81+ --this can always result in a lazy application as long as the relvar exists

10082 deleteRelVar expr relVarName

10183

10284evalDatabaseContextExpr ex@(Assign relVarName expr) = do

src/lib/ProjectM36/DatabaseContextState.hsnew file+29

@@ -0,0 +1,29 @@

1+module ProjectM36.DatabaseContextState where

2+import ProjectM36.Base

3+import ProjectM36.Error

4+import Control.Monad.State

6+type ConstraintValidator = DatabaseContextExpr -> DatabaseContext -> Maybe RelationalError

8+data DatabaseContextEvalState = DatabaseContextEvalState {

9+ dbcontext :: DatabaseContext,

10+ constraintValidator :: ConstraintValidator

11+ }

12+

13+type DatabaseState a = State DatabaseContextEvalState a

14+

15+getDatabaseContext :: DatabaseState DatabaseContext

16+getDatabaseContext = liftM dbcontext get

17+

18+getConstraintValidator :: DatabaseState ConstraintValidator

19+getConstraintValidator = liftM constraintValidator get

20+

21+putDatabaseContext :: DatabaseContext -> DatabaseState ()

22+putDatabaseContext context = do

23+ dbstate <- get

24+ put (dbstate {dbcontext = context})

25+

26+getThunks :: DatabaseState DatabaseContextExpr

27+getThunks = do

28+ context <- getDatabaseContext

29+ pure (thunks context)

src/lib/ProjectM36/IsomorphicSchema.hs+1

@@ -6,6 +6,7 @@ import ProjectM36.MiscUtils

66import ProjectM36.RelationalExpression

77import ProjectM36.RelationalExpressionState

88import ProjectM36.DatabaseContextExpression

9+import ProjectM36.DatabaseContextState

910import ProjectM36.Relation

1011import qualified ProjectM36.AttributeNames as AN

1112import Control.Monad

src/lib/ProjectM36/LazyDatabaseContextExpression.hsnew file+43

@@ -0,0 +1,43 @@

1+module ProjectM36.LazyDatabaseContextExpression where

2+import ProjectM36.Base

3+import ProjecM36.DatabaseState

4+import qualified Data.Set as S

6+-- this function's goal is to retain maximum laziness (thunks)

7+-- returns True iff the expression was added to the lazy state, False if the expression requires further evaluation

8+processThunks :: DatabaseContextExpr -> DatabaseState (Either RelationalError Bool)

10+processThunks NoOperation = pure True

11+

12+--Define can be thunked as long as the name isn't in the thunks

13+processThunks (Define rvName _) = do

14+ thunks' <- getThunks

15+ pure (not (S.member rvName (assignedRelVars thunks')))

16+-- minor optimization opportunity if exprs are Define x, Undefine x, ... Define x, we could successfully retain laziness

17+

18+processThunks (Undefine rvName) = do

19+ --validate that the relvar name does appear previously defined

20+

21+

22+--returns all relvar names which are being assigned in the expr

23+assignedRelVars :: DatabaseContextExpr -> S.Set RelVarName

24+assignedRelVars expr = case expr of

25+ NoOperation -> S.empty

26+ Define rv _ -> S.singleton rv

27+ Undefine rv -> S.singleton rv

28+ Assign rv _ -> S.singleton rv

29+ Insert rv _ -> S.singleton rv

30+ Delete rv _ -> S.singleton rv

31+ Update rv _ _ -> S.singleton rv

32+ AddInclusionDependency _ _ -> S.empty

33+ RemoveInclusionDependency _ -> S.empty

34+ AddTypeConstructor _ _ -> S.empty

35+ RemoveTypeConstructor _ -> S.empty

36+ RemoveAtomFunction _ _ -> S.empty

37+ MultipleExpr exprs = foldr (\e acc -> S.union acc (assignedRelVars e)) S.empty exprs

38+

39+

40+

41+

42+

43+

src/lib/ProjectM36/StaticOptimizer/DatabaseContextExpression.hs+1

@@ -2,6 +2,7 @@ module ProjectM36.StaticOptimizer.DatabaseContextExpression where

22import ProjectM36.Base

33import ProjectM36.Error

44import ProjectM36.DatabaseContext

5+import ProjectM36.DatabaseContextState

56import ProjectM36.DatabaseContextExpression

67import ProjectM36.RelationalExpressionState

78import ProjectM36.StaticOptimizer.RelationalExpression

src/lib/ProjectM36/TransGraphRelationalExpression.hs−11

@@ -12,29 +12,18 @@ import Control.Monad.State

1212import ProjectM36.Tuple

1313import ProjectM36.AtomType

1414import qualified Data.Map as M

15−import Data.Binary

1615

1716-- | The TransGraphRelationalExpression is equivalent to a relational expression except that relation variables can reference points in the transaction graph (at previous points in time).

1817type TransGraphRelationalExpr = RelationalExprBase TransactionIdLookup

1918

20−instance Binary TransGraphRelationalExpr

21−

2219type TransGraphExtendTupleExpr = ExtendTupleExprBase TransactionIdLookup

2320

24−instance Binary TransGraphExtendTupleExpr

25−

2621type TransGraphTupleExpr = TupleExprBase TransactionIdLookup

2722

28−instance Binary TransGraphTupleExpr

29−

3023type TransGraphRestrictionPredicateExpr = RestrictionPredicateExprBase TransactionIdLookup

3124

32−instance Binary TransGraphRestrictionPredicateExpr

33−

3425type TransGraphAtomExpr = AtomExprBase TransactionIdLookup

3526

36−instance Binary TransGraphAtomExpr

37−

3827type TransGraphAttributeExpr = AttributeExprBase TransactionIdLookup

3928

4029-- OUTDATED a previous attempt at this function attempted to convert TransGraphRelationalExpr to RelationalExpr by resolving the transaction lookups. However, there is no way to resolve a FunctionAtomExpr to an Atom without fully evaluating the higher levels (TupleExpr, etc.). An anonymous function expression cannot be serialized, so that workaround is out. Still, I suspect we can reuse the existing static optimizer logic to work on both structures. The current conversion reduces the chance of whole-query optimization due to full-evaluation on top of full-evaluation, so this function would benefit from some re-design.

src/lib/ProjectM36/Transaction/Persist.hs+3−1

@@ -54,13 +54,15 @@ readTransaction dbdir transId = do

5454 incDeps <- readIncDeps transDir

5555 typeCons <- readTypeConstructorMapping transDir

5656 sschemas <- readSubschemas transDir

57+ thunks <- readThunks transDir

5758 --atomFuncs <- readAtomFuncs transDir -- not yet supported since there is no bytecode to serialize yet

5859 let atomFuncs = basicAtomFunctions

5960 let newContext = DatabaseContext { inclusionDependencies = incDeps,

6061 relationVariables = relvars,

6162 typeConstructorMapping = typeCons,

6263 notifications = M.empty,

63− atomFunctions = atomFuncs }

64+ atomFunctions = atomFuncs,

65+ thunks = thunks }

6466 newSchemas = Schemas newContext sschemas

6567 return $ Right $ Transaction transId transInfo newSchemas

6668

src/lib/ProjectM36/TransactionGraph.hs+1−1

@@ -427,7 +427,7 @@ createUnionMergeTransaction newId strategy graph (t1,t2) = do

427427 notifs <- unionMergeMaps preference (notifications contextA) (notifications contextB)

428428 types <- unionMergeTypeConstructorMapping preference (typeConstructorMapping contextA) (typeConstructorMapping contextB)

429429 -- TODO: add merge of subschemas

430− let newContext = DatabaseContext incDeps relVars atomFuncs notifs types

430+ let newContext = DatabaseContext incDeps relVars atomFuncs notifs types NoOperation

431431 newSchemas = Schemas newContext (subschemas t1)

432432 pure (Transaction newId (MergeTransactionInfo (transactionId t1) (transactionId t2) S.empty) newSchemas)

433433