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

git.iko.soy/project-m36

implement TutorialD extend support

no tuple expressions beyond singular attributes are supported- type-specific functions are not yet supported

commit2b5f2493c681405bcd50ab31f3431866738a8bfb authorAgentM <agentm@themactionfaction.com> dateThu 7 May 2015, 22:14 (11 years ago) parent91cfdd0

7 files changed+66−9

compare with master

unifiedsplit

ProjectM36/Base.hs+5 ProjectM36/Relation.hs+1−2 ProjectM36/RelationalExpression.hs+28 ProjectM36/StaticOptimizer.hs+3−2 ProjectM36/Tuple.hs+1−1 TutorialD/Interpreter.hs+25−3 test/TutorialD/Interpreter.hs+3−1

ProjectM36/Base.hs+5

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

107107 Ungroup :: AttributeName -> RelationalExpr -> RelationalExpr

108108 Restrict :: RestrictionPredicateExpr -> RelationalExpr -> RelationalExpr

109109 Equals :: RelationalExpr -> RelationalExpr -> RelationalExpr

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

110111{- maybe break this into multiple steps:

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

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

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

191192instance Ord Transaction where

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

193194

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

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

218218 newAttrs <- A.joinAttributes attrs1 attrs2

219219 return $ Relation newAttrs newTupSet

220−

220+

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

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

223223relMap mapper (Relation attrs tupleSet) = do

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

231231 then Right remappedTuple

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

233233

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

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

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

237236

ProjectM36/RelationalExpression.hs+28

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

88import qualified ProjectM36.Attribute as A

99import qualified Data.Map as M

1010import qualified Data.HashSet as HS

11+import qualified Data.Set as S

12+import qualified Data.Vector as V

1113import Control.Monad.State hiding (join)

1214import Data.Maybe

1315

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

8587 Right relA -> case evaldB of

8688 Left err -> return $ Left err

8789 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

88100

89101emptyDatabaseContext :: DatabaseContext

90102emptyDatabaseContext = DatabaseContext { inclusionDependencies = HS.empty,

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

335347 Left _ -> False

336348 Right atom2 -> atom2 == atom

337349

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

338351

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)))

339362

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

340368

341369

ProjectM36/StaticOptimizer.hs+3−2

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

8888 Left err -> return $ Left err

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

9090

91−applyStaticRelationalOptimization (Equals exprA exprB) = do

92− return $ Right $ Equals exprA exprB

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

92+

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

9394

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

9596applyStaticDatabaseOptimization (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

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

152152 Left $ TupleAttributeCountMismatchError 0

153153 else if attrsTypes /= tupleTypes then

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

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

155155 else

156156 Right $ tuple

157157

TutorialD/Interpreter.hs+25−3

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

2121import qualified Data.HashSet as HS

2222import qualified Data.Map as M

2323import qualified Data.List as L

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

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

2525import Control.Monad.State

2626import System.Console.Haskeline

2727import System.IO

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

191191 rvaAttrName <- identifier

192192 return $ Ungroup (T.pack rvaAttrName)

193193

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+

194202relOperators = [

195203 [Postfix projectOp],

196204 [Postfix renameP],

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

203211 ]

204212

205213relExpr :: Parser RelationalExpr

206−relExpr = buildExpressionParser relOperators relTerm

214+relExpr = extendP <|> buildExpressionParser relOperators relTerm

207215

208216databaseExpr :: Parser DatabaseExpr

209217databaseExpr = insertP

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

500508 Left err -> (Just err, context)

501509 Right parsed -> runState (evalContextExpr parsed) context

502510

503−-- for interpreter-specific operations

511+-- for interpreter-specific operations

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

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

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

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

588596displayTransactionGraph :: TransactionGraph -> String

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

590598-}

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

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

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

4646 ("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]))

4849 ]

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

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

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

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

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

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

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