2b5f249 · project-m36 · git.iko.soy

ProjectM36/Base.hs+5

compare with master

unifiedsplit

@@ -107,6 +107,7 @@ data RelationalExpr where

107 Ungroup :: AttributeName -> RelationalExpr -> RelationalExpr

108 Restrict :: RestrictionPredicateExpr -> RelationalExpr -> RelationalExpr

109 Equals :: RelationalExpr -> RelationalExpr -> RelationalExpr

110+ Extend :: TupleExpr -> RelationalExpr -> RelationalExpr

110{- maybe break this into multiple steps:

111{- maybe break this into multiple steps:

1111. check relational types for match (attribute counts) (typechecking step

1121. check relational types for match (attribute counts) (typechecking step

1122. create an execution plan (another system of nodes, another GADT)

1132. create an execution plan (another system of nodes, another GADT)

@@ -191,3 +192,7 @@ instance Eq Transaction where

191instance Ord Transaction where

192instance Ord Transaction where

192 compare (Transaction uuidA _ _) (Transaction uuidB _ _) = compare uuidA uuidB

193 compare (Transaction uuidA _ _) (Transaction uuidB _ _) = compare uuidA uuidB

193

194

195+--used to extend a relation

196+data TupleExpr = AttributeTupleExpr AttributeName AttributeName |

197+ MultipleTupleExpr [TupleExpr] --new attr, old attr to clone

198+ deriving (Show, Eq)

ProjectM36/Relation.hs+1−2

@@ -217,7 +217,7 @@ join (Relation attrs1 tupSet1) (Relation attrs2 tupSet2) = do

217 tupleSetJoiner tuple1 accumulator = HS.union (singleTupleSetJoin tuple1 tupSet2) accumulator

218 newAttrs <- A.joinAttributes attrs1 attrs2

219 return $ Relation newAttrs newTupSet

220−

220+

221--a map should NOT change the structure of a relation, so attributes should be constant

222relMap :: (RelationTuple -> RelationTuple) -> Relation -> Either RelationalError Relation

223relMap mapper (Relation attrs tupleSet) = do

@@ -231,7 +231,6 @@ relMap mapper (Relation attrs tupleSet) = do

231 then Right remappedTuple

232 else Left $ TupleAttributeTypeMismatchError (A.attributesDifference (tupleAttributes tupleIn) attrs)

233

234−--in the future, the mapper should be able to return a RelationalError likely

235relMogrify :: (RelationTuple -> RelationTuple) -> Attributes -> Relation -> Either RelationalError Relation

234relMogrify :: (RelationTuple -> RelationTuple) -> Attributes -> Relation -> Either RelationalError Relation

236relMogrify mapper newAttributes (Relation _ tupSet) = mkRelation newAttributes (HS.map mapper tupSet)

235relMogrify mapper newAttributes (Relation _ tupSet) = mkRelation newAttributes (HS.map mapper tupSet)

237

236

ProjectM36/RelationalExpression.hs+28

@@ -8,6 +8,8 @@ import ProjectM36.Error

8import qualified ProjectM36.Attribute as A

9import qualified Data.Map as M

10import qualified Data.HashSet as HS

11+import qualified Data.Set as S

12+import qualified Data.Vector as V

11import Control.Monad.State hiding (join)

13import Control.Monad.State hiding (join)

12import Data.Maybe

14import Data.Maybe

13

15

@@ -85,6 +87,16 @@ evalRelationalExpr (Equals relExprA relExprB) = do

85 Right relA -> case evaldB of

87 Right relA -> case evaldB of

86 Left err -> return $ Left err

88 Left err -> return $ Left err

87 Right relB -> return $ Right $ if relA == relB then relationTrue else relationFalse

89 Right relB -> return $ Right $ if relA == relB then relationTrue else relationFalse

90+

91+-- extending a relation adds a single attribute with the results of the per-tuple expression evaluated

92+evalRelationalExpr (Extend tupleExpression relExpr) = do

93+ evald <- evalRelationalExpr relExpr

94+ case evald of

95+ Left err -> return $ Left err

96+ Right rel -> do

97+ case tupleExpressionProcessor rel tupleExpression of

98+ Left err -> return $ Left err

99+ Right (newAttrs, tupProc) -> return $ relMogrify tupProc newAttrs rel

88

100

89emptyDatabaseContext :: DatabaseContext

101emptyDatabaseContext :: DatabaseContext

90emptyDatabaseContext = DatabaseContext { inclusionDependencies = HS.empty,

102emptyDatabaseContext = DatabaseContext { inclusionDependencies = HS.empty,

@@ -335,7 +347,23 @@ predicateRestrictionFilter _ (AttributeEqualityPredicate attrName atom) = Right

335 Left _ -> False

347 Left _ -> False

336 Right atom2 -> atom2 == atom

348 Right atom2 -> atom2 == atom

337

349

350+tupleExpressionProcessor :: Relation -> TupleExpr -> Either RelationalError (Attributes, RelationTuple -> RelationTuple)

338

351

352+--just clone an existing tuple as a new attribute

353+tupleExpressionProcessor relIn

354+ (AttributeTupleExpr newAttrName oldAttrName) = if isNothing $ attributeForName oldAttrName relIn then

355+ Left $ NoSuchAttributeNameError oldAttrName

356+ else if isJust $ attributeForName newAttrName relIn then

357+ Left $ AttributeNameInUseError newAttrName

358+ else do

359+ let newAttrs = A.renameAttributes oldAttrName newAttrName (attributesForNames (S.singleton oldAttrName) relIn)

360+ let newAndOldAttrs = A.addAttributes (attributes relIn) newAttrs

361+ return $ (newAndOldAttrs, \tup -> tupleExtend tup (RelationTuple newAttrs (atomsForAttributeNames (V.singleton oldAttrName) tup)))

339

362

363+tupleExpressionProcessor relIn (MultipleTupleExpr exprList) = do

364+ procList <- mapM (tupleExpressionProcessor relIn) exprList

365+ -- add up all the new attributes from the procList

366+ let folder (attrs, tupProc) (accAttrs, accTupProc) = (A.addAttributes attrs accAttrs, tupProc . accTupProc)

367+ return $ foldl folder (A.emptyAttributes, id) procList

340

368

341

369

ProjectM36/StaticOptimizer.hs+3−2

@@ -88,8 +88,9 @@ applyStaticRelationalOptimization (Restrict predicate expr) = do

88 Left err -> return $ Left err

89 Right optSubExpr -> return $ Right $ Restrict optimizedPredicate2 optSubExpr

90

91−applyStaticRelationalOptimization (Equals exprA exprB) = do

91+applyStaticRelationalOptimization e@(Equals _ _) = return $ Right e

92− return $ Right $ Equals exprA exprB

92+

93+applyStaticRelationalOptimization e@(Extend _ _) = return $ Right e

93

94

94applyStaticDatabaseOptimization :: DatabaseExpr -> DatabaseState (Either RelationalError DatabaseExpr)

95applyStaticDatabaseOptimization :: DatabaseExpr -> DatabaseState (Either RelationalError DatabaseExpr)

95applyStaticDatabaseOptimization (Define name attrs) = return $ Right (Define name attrs)

96applyStaticDatabaseOptimization (Define name attrs) = return $ Right (Define name attrs)

ProjectM36/Tuple.hs+1−1

@@ -151,7 +151,7 @@ verifyTuple attrs tuple = let attrsTypes = V.map atomType attrs

151 if V.length attrs /= V.length tupleTypes then

152 Left $ TupleAttributeCountMismatchError 0

153 else if attrsTypes /= tupleTypes then

154− Left $ TupleAttributeTypeMismatchError (attributesDifference attrs (tupleAttributes tuple))

154+ Left $ TupleAttributeTypeMismatchError (attributesDifference attrs (tupleAttributes tuple))

155 else

156 Right $ tuple

157

TutorialD/Interpreter.hs+25−3

@@ -21,7 +21,7 @@ import qualified Data.Set as S

21import qualified Data.HashSet as HS

22import qualified Data.Map as M

23import qualified Data.List as L

24−import Control.Applicative (liftA, (<*), (*>))

24+import Control.Applicative (liftA, (<*), (*>), (<*>), (<$>))

25import Control.Monad.State

26import System.Console.Haskeline

27import System.IO

@@ -191,6 +191,14 @@ ungroupP = do

191 rvaAttrName <- identifier

192 return $ Ungroup (T.pack rvaAttrName)

193

194+extendP :: Parser RelationalExpr

195+extendP = do

196+ reservedOp "extend"

197+ expr <- relExpr

198+ reservedOp ":"

199+ tupleExpr <- braces tupleExpressionP

200+ return $ Extend tupleExpr expr

201+

194relOperators = [

202relOperators = [

195 [Postfix projectOp],

203 [Postfix projectOp],

196 [Postfix renameP],

204 [Postfix renameP],

@@ -203,7 +211,7 @@ relOperators = [

203 ]

211 ]

204

212

205relExpr :: Parser RelationalExpr

213relExpr :: Parser RelationalExpr

206−relExpr = buildExpressionParser relOperators relTerm

214+relExpr = extendP <|> buildExpressionParser relOperators relTerm

207

215

208databaseExpr :: Parser DatabaseExpr

216databaseExpr :: Parser DatabaseExpr

209databaseExpr = insertP

217databaseExpr = insertP

@@ -500,7 +508,7 @@ interpretNO context tutdstring = case parseString tutdstring of

500 Left err -> (Just err, context)

508 Left err -> (Just err, context)

501 Right parsed -> runState (evalContextExpr parsed) context

509 Right parsed -> runState (evalContextExpr parsed) context

502

510

503−-- for interpreter-specific operations

511+-- for interpreter-specific operations

504interpretOps :: U.UUID -> DisconnectedTransaction -> TransactionGraph -> String -> (DisconnectedTransaction, TransactionGraph, TutorialDOperatorResult)

512interpretOps :: U.UUID -> DisconnectedTransaction -> TransactionGraph -> String -> (DisconnectedTransaction, TransactionGraph, TutorialDOperatorResult)

505interpretOps newUUID trans@(DisconnectedTransaction _ context) transGraph instring = case parse interpreterOps "" instring of

513interpretOps newUUID trans@(DisconnectedTransaction _ context) transGraph instring = case parse interpreterOps "" instring of

506 Left _ -> (trans, transGraph, NoActionResult)

514 Left _ -> (trans, transGraph, NoActionResult)

@@ -588,3 +596,17 @@ intAtomP = do

588displayTransactionGraph :: TransactionGraph -> String

596displayTransactionGraph :: TransactionGraph -> String

589displayTransactionGraph (TransactionGraph _ transSet) = L.intercalate "\n" $ S.foldr (\(Transaction tUUID pUUID _ ) acc -> acc ++ [show tUUID ++ " " ++ show pUUID]) [] transSet

597displayTransactionGraph (TransactionGraph _ transSet) = L.intercalate "\n" $ S.foldr (\(Transaction tUUID pUUID _ ) acc -> acc ++ [show tUUID ++ " " ++ show pUUID]) [] transSet

590-}

598-}

599+

600+multiTupleExpressionP :: Parser TupleExpr

601+multiTupleExpressionP = MultipleTupleExpr <$> (sepBy tupleExpressionP comma)

602+

603+tupleExpressionP :: Parser TupleExpr

604+tupleExpressionP = attributeTupleExpressionP

605+

606+attributeTupleExpressionP :: Parser TupleExpr

607+attributeTupleExpressionP = do

608+ newAttr <- identifier

609+ reservedOp ":="

610+ attr <- identifier

611+ return $ AttributeTupleExpr (T.pack newAttr) (T.pack attr)

612+

test/TutorialD/Interpreter.hs+3−1

@@ -44,11 +44,13 @@ main = do

44 ("x:=true=false", Right relationFalse),

45 ("x:=true; undefine x", Left (RelVarNotDefinedError "x")),

46 ("x:=relation {b int, a char}; insert x relation{tuple{b int(5), a char(\"spam\")}}", mkRelation simpleCAttributes (HS.fromList [RelationTuple simpleCAttributes $ V.fromList [StringAtom "spam", IntAtom 5]])),

47− ("x:=relation{tuple{b int(5),a char(\"spam\")},tuple{b int(6),a char(\"sam\")}}; delete x where b=6", mkRelation simpleCAttributes $ HS.singleton $ RelationTuple simpleCAttributes (V.fromList [StringAtom "spam", IntAtom 5]))

47+ ("x:=relation{tuple{b int(5),a char(\"spam\")},tuple{b int(6),a char(\"sam\")}}; delete x where b=6", mkRelation simpleCAttributes $ HS.singleton $ RelationTuple simpleCAttributes (V.fromList [StringAtom "spam", IntAtom 5])),

48+ ("x:=extend relation{tuple{a int(5)}} : {b:=a}", mkRelation simpleDAttributes $ HS.singleton $ RelationTuple simpleDAttributes (V.fromList [IntAtom 5, IntAtom 5]))

48 ]

49 ]

49 simpleAAttributes = A.attributesFromList [Attribute "a" IntAtomType]

50 simpleAAttributes = A.attributesFromList [Attribute "a" IntAtomType]

50 simpleBAttributes = A.attributesFromList [Attribute "d" IntAtomType]

51 simpleBAttributes = A.attributesFromList [Attribute "d" IntAtomType]

51 simpleCAttributes = A.attributesFromList [Attribute "a" StringAtomType, Attribute "b" IntAtomType]

52 simpleCAttributes = A.attributesFromList [Attribute "a" StringAtomType, Attribute "b" IntAtomType]

53+ simpleDAttributes = A.attributesFromList [Attribute "a" IntAtomType, Attribute "b" IntAtomType]

52 simpleProjectionAttributes = A.attributesFromList [Attribute "c" IntAtomType]

54 simpleProjectionAttributes = A.attributesFromList [Attribute "c" IntAtomType]

53 dateExampleRelTests = [("x:=S where true", Right suppliersRel),

55 dateExampleRelTests = [("x:=S where true", Right suppliersRel),

54 ("x:=S where CITY = \"London\"", restrict (\tuple -> atomForAttributeName "CITY" tuple == (Right $ StringAtom "London")) suppliersRel),

56 ("x:=S where CITY = \"London\"", restrict (\tuple -> atomForAttributeName "CITY" tuple == (Right $ StringAtom "London")) suppliersRel),