5582a55 · project-m36 · git.iko.soy

git.iko.soy/project-m36

on master help sign in

-further polish tuple expression parsing

5582a55AgentM11 years ago

ProjectM36/Base.hs+1−1

compare with master

unifiedsplit

@@ -154,7 +154,7 @@ data RestrictionPredicateExpr where

154 OrPredicate :: RestrictionPredicateExpr -> RestrictionPredicateExpr -> RestrictionPredicateExpr

155 NotPredicate :: RestrictionPredicateExpr -> RestrictionPredicateExpr

156 RelationalExprPredicate :: RelationalExpr -> RestrictionPredicateExpr --type must be same as true and false relations (no attributes)

157− AttributeEqualityPredicate :: AttributeName -> Atom -> RestrictionPredicateExpr -- relationalexpr must result in relation with single tuple

157+ AttributeEqualityPredicate :: AttributeName -> AtomExpr -> RestrictionPredicateExpr -- relationalexpr must result in relation with single tuple

158 deriving (Show, Eq)

159

160-- child + parent links

ProjectM36/Error.hs+1

@@ -28,6 +28,7 @@ data RelationalError = NoSuchAttributeNameError AttributeName

28 | NoSuchTupleExprFunctionError AtomFunctionName

29 | AtomTypeMismatchError AtomType AtomType

30 | AtomTypeCountError [AtomType] [AtomType]

31+ | AtomFunctionTypeError AtomFunctionName Int AtomType AtomType --arg number

31 deriving (Show,Eq,Generic)

32 deriving (Show,Eq,Generic)

ProjectM36/Relation/Show/Term.hs+4−1

@@ -109,7 +109,10 @@ renderHBar :: StringType -> StringType -> StringType -> [Int] -> StringType

109renderHBar left middle end columnLocations = left `T.append` T.concat (L.intersperse middle (map (\x -> repeatString x boxH) columnLocations)) `T.append` end

110

111leftPaddedString :: Int -> Int -> StringType -> StringType

112−leftPaddedString lineNum size str = paddedLines !! lineNum

112+leftPaddedString lineNum size str = if lineNum > length paddedLines -1 then

113+ repeatString size " "

114+ else

115+ paddedLines !! lineNum

113 where

116 where

114 paddedLines = map (\line -> line `T.append` repeatString (size - T.length line) " ") (breakLines str)

117 paddedLines = map (\line -> line `T.append` repeatString (size - T.length line) " ") (breakLines str)

115

118

ProjectM36/RelationalExpression.hs+44−22

@@ -12,6 +12,7 @@ import qualified Data.HashSet as HS

12import Control.Monad.State hiding (join)

13import Data.Maybe

14import Data.Either

15+import Debug.Trace

16--relvar state is needed in evaluation of relational expression but only as read-only in order to extract current relvar values

17--relvar state is needed in evaluation of relational expression but only as read-only in order to extract current relvar values

17evalRelationalExpr :: RelationalExpr -> DatabaseState (Either RelationalError Relation)

18evalRelationalExpr :: RelationalExpr -> DatabaseState (Either RelationalError Relation)

@@ -91,11 +92,11 @@ evalRelationalExpr (Equals relExprA relExprB) = do

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

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

92evalRelationalExpr (Extend tupleExpression relExpr) = do

93evalRelationalExpr (Extend tupleExpression relExpr) = do

93 evald <- evalRelationalExpr relExpr

94 evald <- evalRelationalExpr relExpr

94− funcs <- liftM atomFunctions get

95+ context <- get

95 case evald of

96 case evald of

96 Left err -> return $ Left err

97 Left err -> return $ Left err

97 Right rel -> do

98 Right rel -> do

98− case tupleExpressionProcessor rel tupleExpression funcs of

99+ case tupleExpressionProcessor rel tupleExpression context of

99 Left err -> return $ Left err

100 Left err -> return $ Left err

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

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

101

102

@@ -147,7 +148,7 @@ supplierProductsRel = case mkRelationFromList attrs matrix of

147 where

148 where

148 attrs = A.attributesFromList [Attribute "S#" StringAtomType,

149 attrs = A.attributesFromList [Attribute "S#" StringAtomType,

149 Attribute "P#" StringAtomType,

150 Attribute "P#" StringAtomType,

150− Attribute "QTY" StringAtomType]

151+ Attribute "QTY" IntAtomType]

151 matrix = [

152 matrix = [

152 [StringAtom "S1", StringAtom "P1", IntAtom 300],

153 [StringAtom "S1", StringAtom "P1", IntAtom 300],

153 [StringAtom "S1", StringAtom "P2", IntAtom 200],

154 [StringAtom "S1", StringAtom "P2", IntAtom 200],

@@ -165,13 +166,13 @@ supplierProductsRel = case mkRelationFromList attrs matrix of

165

166

166productsRel :: Relation

167productsRel :: Relation

167productsRel = case mkRelationFromList attrs matrix of

168productsRel = case mkRelationFromList attrs matrix of

168− Left _ -> undefined

169+ Left err -> traceShow (show err) undefined

169 Right rel -> rel

170 Right rel -> rel

170 where

171 where

171 attrs = A.attributesFromList [Attribute "P#" StringAtomType,

172 attrs = A.attributesFromList [Attribute "P#" StringAtomType,

172 Attribute "PNAME" StringAtomType,

173 Attribute "PNAME" StringAtomType,

173 Attribute "COLOR" StringAtomType,

174 Attribute "COLOR" StringAtomType,

174− Attribute "WEIGHT" StringAtomType,

175+ Attribute "WEIGHT" IntAtomType,

175 Attribute "CITY" StringAtomType]

176 Attribute "CITY" StringAtomType]

176 matrix = [

177 matrix = [

177 [StringAtom "P1", StringAtom "Nut", StringAtom "Red", IntAtom 12, StringAtom "London"],

178 [StringAtom "P1", StringAtom "Nut", StringAtom "Red", IntAtom 12, StringAtom "London"],

@@ -352,9 +353,13 @@ predicateRestrictionFilter context (RelationalExprPredicate relExpr) = case runS

352 else

353 else

353 Left $ PredicateExpressionError "Relational restriction filter must evaluate to 'true' or 'false'"

354 Left $ PredicateExpressionError "Relational restriction filter must evaluate to 'true' or 'false'"

354

355

355−predicateRestrictionFilter _ (AttributeEqualityPredicate attrName atom) = Right $ \tupleIn -> case atomForAttributeName attrName tupleIn of

356+predicateRestrictionFilter context (AttributeEqualityPredicate attrName atomexpr) = Right $ \tupleIn -> case atomForAttributeName attrName tupleIn of

356 Left _ -> False

357 Left _ -> False

357− Right atom2 -> atom2 == atom

358+ Right atomIn ->

359+ case evalAtomExpr tupleIn context atomexpr of

360+ Left _ -> False

361+ Right atomCmp -> atomCmp == atomIn

362+

358

363

359tupleExprCheckNewAttrName :: AttributeName -> Relation -> Either RelationalError Relation

364tupleExprCheckNewAttrName :: AttributeName -> Relation -> Either RelationalError Relation

360tupleExprCheckNewAttrName attrName rel = if isRight $ attributeForName attrName rel then

365tupleExprCheckNewAttrName attrName rel = if isRight $ attributeForName attrName rel then

@@ -362,15 +367,15 @@ tupleExprCheckNewAttrName attrName rel = if isRight $ attributeForName attrName

362 else

367 else

363 Right rel

368 Right rel

364

369

365−tupleExpressionProcessor :: Relation -> TupleExpr -> AtomFunctions -> Either RelationalError (Attributes, RelationTuple -> RelationTuple)

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

366tupleExpressionProcessor relIn

371tupleExpressionProcessor relIn

367− (AttributeTupleExpr newAttrName atomExpr) functions = do

372+ (AttributeTupleExpr newAttrName atomExpr) context = do

368 _ <- tupleExprCheckNewAttrName newAttrName relIn

373 _ <- tupleExprCheckNewAttrName newAttrName relIn

369− atomExprType <- typeFromAtomExpr (attributes relIn) functions atomExpr

374+ atomExprType <- typeFromAtomExpr (attributes relIn) context atomExpr

370− _ <- verifyAtomExprTypes relIn functions atomExpr atomExprType

375+ _ <- verifyAtomExprTypes relIn context atomExpr atomExprType

371 let newAttrs = A.attributesFromList [Attribute newAttrName atomExprType]

376 let newAttrs = A.attributesFromList [Attribute newAttrName atomExprType]

372 newAndOldAttrs = A.addAttributes (attributes relIn) newAttrs

377 newAndOldAttrs = A.addAttributes (attributes relIn) newAttrs

373− return $ (newAndOldAttrs, \tup -> case evalAtomExpr tup functions atomExpr of

378+ return $ (newAndOldAttrs, \tup -> case evalAtomExpr tup context atomExpr of

374 Left _ -> undefined -- ?!

379 Left _ -> undefined -- ?!

375 Right atom -> tupleAtomExtend newAttrName atom tup)

380 Right atom -> tupleAtomExtend newAttrName atom tup)

376

381

@@ -394,26 +399,40 @@ atomFunctionForName funcName funcSet = if HS.null foundFunc then

394 where

399 where

395 foundFunc = HS.filter (\(AtomFunction name _ _) -> name == funcName) funcSet

400 foundFunc = HS.filter (\(AtomFunction name _ _) -> name == funcName) funcSet

396

401

397−typeFromAtomExpr :: Attributes -> AtomFunctions -> AtomExpr -> Either RelationalError AtomType

402+typeFromAtomExpr :: Attributes -> DatabaseContext -> AtomExpr -> Either RelationalError AtomType

398typeFromAtomExpr attrs _ (AttributeAtomExpr attrName) = A.atomTypeForAttributeName attrName attrs

403typeFromAtomExpr attrs _ (AttributeAtomExpr attrName) = A.atomTypeForAttributeName attrName attrs

399typeFromAtomExpr _ _ (NakedAtomExpr atom) = Right (atomTypeForAtom atom)

404typeFromAtomExpr _ _ (NakedAtomExpr atom) = Right (atomTypeForAtom atom)

400−typeFromAtomExpr _ funcs (FunctionAtomExpr funcName _) = do

405+typeFromAtomExpr _ context (FunctionAtomExpr funcName _) = do

406+ let funcs = atomFunctions context

401 func <- atomFunctionForName funcName funcs

407 func <- atomFunctionForName funcName funcs

402 return $ last (atomFuncType func)

408 return $ last (atomFuncType func)

409+typeFromAtomExpr _ context (RelationAtomExpr relExpr) = do

410+ relType <- evalState (typeForRelationalExpr relExpr) context

411+ return $ RelationAtomType (attributes relType)

412+

403

413

404−verifyAtomExprTypes :: Relation -> AtomFunctions -> AtomExpr -> AtomType -> Either RelationalError AtomType

414+verifyAtomExprTypes :: Relation -> DatabaseContext -> AtomExpr -> AtomType -> Either RelationalError AtomType

405verifyAtomExprTypes relIn _ (AttributeAtomExpr attrName) expectedType = do

415verifyAtomExprTypes relIn _ (AttributeAtomExpr attrName) expectedType = do

406 attrType <- A.atomTypeForAttributeName attrName (attributes relIn)

416 attrType <- A.atomTypeForAttributeName attrName (attributes relIn)

407 atomTypeVerify expectedType attrType

417 atomTypeVerify expectedType attrType

408verifyAtomExprTypes _ _ (NakedAtomExpr atom) expectedType = atomTypeVerify expectedType (atomTypeForAtom atom)

418verifyAtomExprTypes _ _ (NakedAtomExpr atom) expectedType = atomTypeVerify expectedType (atomTypeForAtom atom)

409−verifyAtomExprTypes relIn functions (FunctionAtomExpr funcName funcArgExprs) expectedType = do

419+verifyAtomExprTypes relIn context (FunctionAtomExpr funcName funcArgExprs) expectedType = do

420+ let functions = atomFunctions context

410 func <- atomFunctionForName funcName functions

421 func <- atomFunctionForName funcName functions

411 let expectedArgTypes = atomFuncType func

422 let expectedArgTypes = atomFuncType func

412− funcArgTypes <- mapM (\(atomExpr,expectedType) -> verifyAtomExprTypes relIn functions atomExpr expectedType) $ zip funcArgExprs expectedArgTypes

423+ funcArgTypes <- mapM (\(atomExpr,expectedType2,argCount) -> case verifyAtomExprTypes relIn context atomExpr expectedType2 of

424+ Left (AtomTypeMismatchError expSubType actSubType) -> Left $ AtomFunctionTypeError funcName argCount expSubType actSubType

425+ Left err -> Left err

426+ Right x -> Right x

427+ ) $ zip3 funcArgExprs expectedArgTypes [1..]

413 if length funcArgTypes /= length expectedArgTypes - 1 then

428 if length funcArgTypes /= length expectedArgTypes - 1 then

414 Left $ AtomTypeCountError funcArgTypes expectedArgTypes

429 Left $ AtomTypeCountError funcArgTypes expectedArgTypes

415 else do

430 else do

416 atomTypeVerify expectedType (last expectedArgTypes)

431 atomTypeVerify expectedType (last expectedArgTypes)

432+verifyAtomExprTypes _ context (RelationAtomExpr relationExpr) expectedType = do

433+ case runState (typeForRelationalExpr relationExpr) context of

434+ (Left err, _) -> Left err

435+ (Right relType, _) -> atomTypeVerify expectedType (RelationAtomType (attributes relType))

417

436

418--determine if two types are equal or compatible

437--determine if two types are equal or compatible

419atomTypeVerify :: AtomType -> AtomType -> Either RelationalError AtomType

438atomTypeVerify :: AtomType -> AtomType -> Either RelationalError AtomType

@@ -424,14 +443,17 @@ atomTypeVerify x y = if x == y then

424 else

443 else

425 Left $ AtomTypeMismatchError x y

444 Left $ AtomTypeMismatchError x y

426

445

427−evalAtomExpr :: RelationTuple -> AtomFunctions -> AtomExpr -> Either RelationalError Atom

446+evalAtomExpr :: RelationTuple -> DatabaseContext -> AtomExpr -> Either RelationalError Atom

428evalAtomExpr tupIn _ (AttributeAtomExpr attrName) = atomForAttributeName attrName tupIn

447evalAtomExpr tupIn _ (AttributeAtomExpr attrName) = atomForAttributeName attrName tupIn

429evalAtomExpr _ _ (NakedAtomExpr atom) = Right atom

448evalAtomExpr _ _ (NakedAtomExpr atom) = Right atom

430−evalAtomExpr tupIn functions (FunctionAtomExpr funcName arguments) = do

449+evalAtomExpr tupIn context (FunctionAtomExpr funcName arguments) = do

450+ let functions = atomFunctions context

431 func <- atomFunctionForName funcName functions

451 func <- atomFunctionForName funcName functions

432− argTypes <- mapM (typeFromAtomExpr (tupleAttributes tupIn) functions) arguments

452+ argTypes <- mapM (typeFromAtomExpr (tupleAttributes tupIn) context) arguments

433 _ <- mapM (uncurry atomTypeVerify) $ init (zip (atomFuncType func) argTypes)

453 _ <- mapM (uncurry atomTypeVerify) $ init (zip (atomFuncType func) argTypes)

434− evaldArgs <- mapM (evalAtomExpr tupIn functions) arguments

454+ evaldArgs <- mapM (evalAtomExpr tupIn context) arguments

435 return $ (atomFunc func) evaldArgs

455 return $ (atomFunc func) evaldArgs

436−

456+evalAtomExpr _ context (RelationAtomExpr relExpr) = do

457+ relAtom <- evalState (evalRelationalExpr relExpr) context

458+ return $ RelationAtom relAtom

437

459

TutorialD/Interpreter.hs+12−10

@@ -53,6 +53,7 @@ lexer = Token.makeTokenParser tutD

53 Token.reservedOpNames = ["join", "where", "union", "group", "ungroup"],

54 Token.reservedNames = [],

55 Token.identStart = letter <|> char '_',

56+ Token.opLetter = oneOf ":!#$%&*+./<=>?\\^|-~", -- remove "@" so it can be used as attribute marker without spaces

56 Token.identLetter = alphaNum <|> char '_' <|> char '#'} -- # needed for Date examples

57 Token.identLetter = alphaNum <|> char '_' <|> char '#'} -- # needed for Date examples

58parens = Token.parens lexer

59parens = Token.parens lexer

@@ -191,15 +192,14 @@ ungroupP = do

191 rvaAttrName <- identifier

192 rvaAttrName <- identifier

192 return $ Ungroup (T.pack rvaAttrName)

193 return $ Ungroup (T.pack rvaAttrName)

193

194

194−extendP :: Parser RelationalExpr

195+extendP :: Parser (RelationalExpr -> RelationalExpr)

195extendP = do

196extendP = do

196− reservedOp "extend"

197− expr <- relExpr

198 reservedOp ":"

197 reservedOp ":"

199 tupleExpr <- braces tupleExpressionP

198 tupleExpr <- braces tupleExpressionP

200− return $ Extend tupleExpr expr

199+ return $ Extend tupleExpr

201

200

202relOperators = [

201relOperators = [

202+ [Postfix extendP],

203 [Postfix projectOp],

204 [Postfix renameP],

205 [Postfix whereClauseP],

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

211 ]

212

213relExpr :: Parser RelationalExpr

214−relExpr = extendP <|> buildExpressionParser relOperators relTerm

214+relExpr = buildExpressionParser relOperators relTerm

215

216databaseExpr :: Parser DatabaseExpr

217databaseExpr = insertP

@@ -579,8 +579,8 @@ restrictionAttributeEqualityP :: Parser RestrictionPredicateExpr

579restrictionAttributeEqualityP = do

580 attributeName <- identifier

581 reservedOp "="

582− atom <- stringAtomP <|> intAtomP

582+ atomexpr <- atomExprP

583− return $ AttributeEqualityPredicate (T.pack attributeName) atom

583+ return $ AttributeEqualityPredicate (T.pack attributeName) atomexpr

584

585quotedChar = noneOf "\""

586 <|> try (string "\"\"" >> return '"')

@@ -588,7 +588,7 @@ quotedChar = noneOf "\""

588stringAtomP = liftA (StringAtom . T.pack) (string "\"" *> many quotedChar <* string "\"")

589

590intAtomP = do

591− intstr <- many digit

591+ intstr <- many1 digit

592 return $ IntAtom (read intstr)

593

594--used by :dumpGraph

@@ -612,11 +612,13 @@ attributeTupleExpressionP = do

612

613atomExprP :: Parser AtomExpr

614atomExprP = try functionAtomExprP <|>

615− attributeAtomExprP <|>

615+ attributeAtomExprP <|>

616− nakedAtomExprP

616+ nakedAtomExprP <|>

617+ relationalAtomExprP

617

618

618attributeAtomExprP :: Parser AtomExpr

619attributeAtomExprP :: Parser AtomExpr

619attributeAtomExprP = do

620attributeAtomExprP = do

621+ _ <- string "@"

620 attrName <- identifier

622 attrName <- identifier

621 return $ AttributeAtomExpr (T.pack attrName)

623 return $ AttributeAtomExpr (T.pack attrName)

622

624

test/Relation/Basic.hs+6−1

@@ -9,11 +9,15 @@ import qualified ProjectM36.Attribute as A

9import qualified Data.HashSet as HS

10import qualified Data.Vector as V

11import System.Exit

12+import ProjectM36.RelationalExpression

13testList :: Test

14testList :: Test

14testList = TestList [testRelation "relationTrue" relationTrue, testRelation "relationFalse" relationFalse,

15testList = TestList [testRelation "relationTrue" relationTrue, testRelation "relationFalse" relationFalse,

15 testMkRelation1,

16 testMkRelation1,

16− testRename1, testRename2]

17+ testRename1, testRename2,

18+ testRelation "suppliers" suppliersRel,

19+ testRelation "products" productsRel,

20+ testRelation "supplierProducts" supplierProductsRel]

18main :: IO ()

22main :: IO ()

19main = do

23main = do

@@ -76,3 +80,4 @@ testMkRelation1 = TestCase $ assertEqual "key mismatch" (Left $ TupleAttributeTy

76 testAttrs = A.attributesFromList [Attribute "a" StringAtomType]

80 testAttrs = A.attributesFromList [Attribute "a" StringAtomType]

77 testTupSet = HS.fromList [mkRelationTuple testAttrs $ V.fromList [StringAtom "v"],

81 testTupSet = HS.fromList [mkRelationTuple testAttrs $ V.fromList [StringAtom "v"],

78 mkRelationTuple testAttrs $ V.fromList [IntAtom 2]]

82 mkRelationTuple testAttrs $ V.fromList [IntAtom 2]]

83+

test/TutorialD/Interpreter.hs+10−2

@@ -45,19 +45,27 @@ main = do

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

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

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

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

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

51+ ("x:=relation{tuple{a int(5)}} : {b:=add(@a,\"spam\")}", Left (AtomFunctionTypeError "add" 2 IntAtomType StringAtomType)),

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

49 ]

53 ]

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

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

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

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

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

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

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

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

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

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

59+ extendTestAttributes = A.attributesFromList [Attribute "a" IntAtomType, Attribute "b" $ RelationAtomType (attributes suppliersRel)]

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

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

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

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

57 ("x:=S where false", Right $ Relation (attributes suppliersRel) emptyTupleSet),

62 ("x:=S where false", Right $ Relation (attributes suppliersRel) emptyTupleSet),

58 ("a:=S; update a (STATUS:=50); x:=a{STATUS}", mkRelation (A.attributesFromList [ Attribute "STATUS" IntAtomType]) (HS.singleton $ mkRelationTuple (A.attributesFromList [Attribute "STATUS" IntAtomType]) (V.fromList [IntAtom 50]))),

63 ("a:=S; update a (STATUS:=50); x:=a{STATUS}", mkRelation (A.attributesFromList [ Attribute "STATUS" IntAtomType]) (HS.singleton $ mkRelationTuple (A.attributesFromList [Attribute "STATUS" IntAtomType]) (V.fromList [IntAtom 50]))),

64+ ("x:=(S : {STATUS2 := add(10,@STATUS)} where STATUS2=add(10,@STATUS)){CITY,S#,SNAME,STATUS}", Right suppliersRel),

59− ("x:=S; update x where SNAME=\"Blake\" (CITY:=\"Boston\")", relMap (\tuple -> if atomForAttributeName "SNAME" tuple == (Right $ StringAtom "Blake") then updateTuple (M.singleton "CITY" (StringAtom "Boston")) tuple else tuple) suppliersRel)

65+ ("x:=S; update x where SNAME=\"Blake\" (CITY:=\"Boston\")", relMap (\tuple -> if atomForAttributeName "SNAME" tuple == (Right $ StringAtom "Blake") then updateTuple (M.singleton "CITY" (StringAtom "Boston")) tuple else tuple) suppliersRel),

66+ ("x:=relation{tuple{a int(5)}} : {b:=S}", mkRelation extendTestAttributes (HS.singleton $ mkRelationTuple extendTestAttributes (V.fromList [IntAtom 5, RelationAtom suppliersRel])))

60 ]

67 ]

68+

61assertTutdEqual :: DatabaseContext -> Either RelationalError Relation -> String -> Assertion

69assertTutdEqual :: DatabaseContext -> Either RelationalError Relation -> String -> Assertion

62assertTutdEqual databaseContext expected tutd = assertEqual tutd expected interpreted

70assertTutdEqual databaseContext expected tutd = assertEqual tutd expected interpreted

63 where

71 where