db6f80d · project-m36 · git.iko.soy

git.iko.soy/project-m36

on master help sign in

add boolean atoms, boolean functions, boolean function restriction

db6f80dAgentM11 years ago

ProjectM36/Atom.hs+1

compare with master

unifiedsplit

@@ -11,3 +11,4 @@ atomTypeForAtom :: Atom -> AtomType

11atomTypeForAtom (StringAtom _) = StringAtomType

12atomTypeForAtom (IntAtom _) = IntAtomType

13atomTypeForAtom (RelationAtom (Relation attributes _)) = RelationAtomType attributes

14+atomTypeForAtom (BoolAtom _) = BoolAtomType

ProjectM36/Base.hs+3

@@ -17,6 +17,7 @@ type StringType = T.Text

18data Atom = StringAtom StringType |

19 IntAtom Int |

20+ BoolAtom Bool |

20 RelationAtom Relation

21 RelationAtom Relation

21 deriving (Show, Eq, Generic)

22 deriving (Show, Eq, Generic)

@@ -26,6 +27,7 @@ instance Hash.Hashable Atom

27data AtomType = StringAtomType |

28data AtomType = StringAtomType |

28 IntAtomType |

29 IntAtomType |

30+ BoolAtomType |

29 RelationAtomType Attributes |

31 RelationAtomType Attributes |

30 AnyAtomType --AnyAtomType is used as a wildcard

32 AnyAtomType --AnyAtomType is used as a wildcard

31 deriving (Eq, Show, Generic)

33 deriving (Eq, Show, Generic)

@@ -150,6 +152,7 @@ data RestrictionPredicateExpr where

150 OrPredicate :: RestrictionPredicateExpr -> RestrictionPredicateExpr -> RestrictionPredicateExpr

152 OrPredicate :: RestrictionPredicateExpr -> RestrictionPredicateExpr -> RestrictionPredicateExpr

151 NotPredicate :: RestrictionPredicateExpr -> RestrictionPredicateExpr

153 NotPredicate :: RestrictionPredicateExpr -> RestrictionPredicateExpr

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

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

155+ AtomExprPredicate :: AtomExpr -> RestrictionPredicateExpr --atom must evaluate to boolean

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

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

154 deriving (Show, Eq)

157 deriving (Show, Eq)

155

158

ProjectM36/Relation.hs+1−8

@@ -30,11 +30,6 @@ attributesForNames attrNameSet (Relation attrs _) = A.attributesForNames attrNam

30atomTypeForName :: AttributeName -> Relation -> Either RelationalError AtomType

31atomTypeForName attrName (Relation attrs _) = A.atomTypeForAttributeName attrName attrs

33−atomValueType :: Atom -> AtomType

34−atomValueType (StringAtom _) = StringAtomType

35−atomValueType (IntAtom _) = IntAtomType

36−atomValueType (RelationAtom rel) = RelationAtomType (attributes rel)

37−

38mkRelationFromList :: Attributes -> [[Atom]] -> Either RelationalError Relation

33mkRelationFromList :: Attributes -> [[Atom]] -> Either RelationalError Relation

39mkRelationFromList attrs atomMatrix = do

34mkRelationFromList attrs atomMatrix = do

40 tupSet <- mkTupleSetFromList attrs atomMatrix

35 tupSet <- mkTupleSetFromList attrs atomMatrix

@@ -182,13 +177,11 @@ ungroup relvalAttrName rel = case attributesForRelval relvalAttrName rel of

182 newAttrs = A.addAttributes relvalAttrs nonGroupAttrs

177 newAttrs = A.addAttributes relvalAttrs nonGroupAttrs

183 nonGroupAttrs = A.deleteAttributeName relvalAttrName (attributes rel)

178 nonGroupAttrs = A.deleteAttributeName relvalAttrName (attributes rel)

184 relFolder :: RelationTuple -> Either RelationalError Relation -> Either RelationalError Relation

179 relFolder :: RelationTuple -> Either RelationalError Relation -> Either RelationalError Relation

185− relFolder tupleIn acc = case (tupleUngroup relvalAttrName newAttrs tupleIn) of

180+ relFolder tupleIn acc = case acc of

186− Right ungroupRelation -> case acc of

187 Left err -> Left err

181 Left err -> Left err

188 Right accRel -> do

182 Right accRel -> do

189 ungrouped <- tupleUngroup relvalAttrName newAttrs tupleIn

183 ungrouped <- tupleUngroup relvalAttrName newAttrs tupleIn

190 union accRel ungrouped

184 union accRel ungrouped

191− Left err -> Left err

192

185

193--take an relval attribute name and a tuple and ungroup the relval

186--take an relval attribute name and a tuple and ungroup the relval

194tupleUngroup :: AttributeName -> Attributes -> RelationTuple -> Either RelationalError Relation

187tupleUngroup :: AttributeName -> Attributes -> RelationTuple -> Either RelationalError Relation

ProjectM36/Relation/Show/CSV.hs+2−1

@@ -17,8 +17,9 @@ instance ToRecord RelationTuple where

17 toRecord tuple = toRecord $ map toField (V.toList $ tupleAtoms tuple)

19instance ToField Atom where

20+ toField (BoolAtom atom) = toField (if atom then "t" else "f")

20 toField (StringAtom atom) = toField atom

21 toField (StringAtom atom) = toField atom

21 toField (IntAtom atom) = toField atom

22 toField (IntAtom atom) = toField atom

22− toField (RelationAtom atom) = undefined -- CSV does not support nested relations- this should likely be detected and rejected

23+ toField (RelationAtom _) = undefined -- CSV does not support nested relations- this should likely be detected and rejected

ProjectM36/Relation/Show/HTML.hs+1

@@ -31,6 +31,7 @@ atomAsHTML :: Atom -> Text

31atomAsHTML (StringAtom atom) = atom

32atomAsHTML (IntAtom int) = pack (show int)

33atomAsHTML (RelationAtom rel) = relationAsHTML rel

34+atomAsHTML (BoolAtom bool) = pack (show bool)

35tupleAsHTML :: RelationTuple -> Text

36tupleAsHTML :: RelationTuple -> Text

36tupleAsHTML tuple = "<tr>" `append` T.concat (L.map tupleFrag (tupleSortedAssocs tuple)) `append` "</tr>"

37tupleAsHTML tuple = "<tr>" `append` T.concat (L.map tupleFrag (tupleSortedAssocs tuple)) `append` "</tr>"

ProjectM36/Relation/Show/Term.hs+1

@@ -95,6 +95,7 @@ showAtom :: Atom -> StringType

95showAtom (StringAtom atom) = atom

96showAtom (IntAtom atom) = T.pack $ show atom

97showAtom (RelationAtom rel) = renderTable $ relationAsTable rel

98+showAtom (BoolAtom bool) = T.pack $ show bool

99renderTable :: Table -> StringType

100renderTable :: Table -> StringType

100renderTable table = renderHeader table (fst cellLocs) `T.append` renderBody (snd table) cellLocs

101renderTable table = renderHeader table (fst cellLocs) `T.append` renderBody (snd table) cellLocs

ProjectM36/RelationalExpression.hs+64−31

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

13import Control.Monad.State hiding (join)

14import Data.Maybe

15import Data.Either

16−import Debug.Trace

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

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

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

@@ -77,7 +76,7 @@ evalRelationalExpr (Restrict predicateExpr relExpr) = do

77 context <- get

76 context <- get

78 case evald of

77 case evald of

79 Left err -> return $ Left err

78 Left err -> return $ Left err

80− Right rel -> case predicateRestrictionFilter context predicateExpr of

79+ Right rel -> case predicateRestrictionFilter context (attributes rel) predicateExpr of

81 Left err -> return $ Left err

80 Left err -> return $ Left err

82 Right filterfunc -> return $ restrict filterfunc rel

81 Right filterfunc -> return $ restrict filterfunc rel

@@ -167,7 +166,7 @@ supplierProductsRel = case mkRelationFromList attrs matrix of

167

166

168productsRel :: Relation

167productsRel :: Relation

169productsRel = case mkRelationFromList attrs matrix of

168productsRel = case mkRelationFromList attrs matrix of

170− Left err -> traceShow (show err) undefined

169+ Left _ -> undefined

171 Right rel -> rel

170 Right rel -> rel

172 where

171 where

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

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

@@ -242,20 +241,20 @@ evalContextExpr (Delete relVarName predicate) = do

242evalContextExpr (Update relVarName attrAssignments restrictionPredicateExpr) = do

241evalContextExpr (Update relVarName attrAssignments restrictionPredicateExpr) = do

243 currstate <- get

242 currstate <- get

244 let relVarTable = relationVariables currstate

243 let relVarTable = relationVariables currstate

245− case predicateRestrictionFilter currstate restrictionPredicateExpr of

246− Left err -> return $ Just err

247− Right predicateFunc -> do

248− case M.lookup relVarName relVarTable of

244+ case M.lookup relVarName relVarTable of

249− Nothing -> return $ Just (RelVarNotDefinedError relVarName)

245+ Nothing -> return $ Just (RelVarNotDefinedError relVarName)

246+ Just rel -> case predicateRestrictionFilter currstate (attributes rel) restrictionPredicateExpr of

247+ Left err -> return $ Just err

248+ Right predicateFunc -> do

250− Just rel -> case makeUpdatedRel rel of

249+ case makeUpdatedRel rel of

251− Left err -> return $ Just err

250+ Left err -> return $ Just err

252− Right updatedRel -> setRelVar relVarName updatedRel

251+ Right updatedRel -> setRelVar relVarName updatedRel

253− where

252+ where

254− makeUpdatedRel relin = do

253+ makeUpdatedRel relin = do

255− restrictedPortion <- restrict predicateFunc relin

254+ restrictedPortion <- restrict predicateFunc relin

256− unrestrictedPortion <- restrict (not . predicateFunc) relin

255+ unrestrictedPortion <- restrict (not . predicateFunc) relin

257− updatedPortion <- relMap (updateTuple attrAssignments) restrictedPortion

256+ updatedPortion <- relMap (updateTuple attrAssignments) restrictedPortion

258− union updatedPortion unrestrictedPortion

257+ union updatedPortion unrestrictedPortion

259

258

260evalContextExpr (AddInclusionDependency dep) = do

259evalContextExpr (AddInclusionDependency dep) = do

261 currstate <- get

260 currstate <- get

@@ -328,24 +327,24 @@ contextWithEmptyTupleSets contextIn = DatabaseContext incDeps relVars funcs

328 funcs = atomFunctions contextIn

327 funcs = atomFunctions contextIn

329

328

330{- used for restrictions- take the restrictionpredicate and return the corresponding filter function -}

329{- used for restrictions- take the restrictionpredicate and return the corresponding filter function -}

331−predicateRestrictionFilter :: DatabaseContext -> RestrictionPredicateExpr -> Either RelationalError (RelationTuple -> Bool)

330+predicateRestrictionFilter :: DatabaseContext -> Attributes -> RestrictionPredicateExpr -> Either RelationalError (RelationTuple -> Bool)

332−predicateRestrictionFilter context (AndPredicate expr1 expr2) = do

331+predicateRestrictionFilter context attrs (AndPredicate expr1 expr2) = do

333− expr1v <- predicateRestrictionFilter context expr1

332+ expr1v <- predicateRestrictionFilter context attrs expr1

334− expr2v <- predicateRestrictionFilter context expr2

333+ expr2v <- predicateRestrictionFilter context attrs expr2

335 return $ \x -> expr1v x && expr2v x

334 return $ \x -> expr1v x && expr2v x

336

335

337−predicateRestrictionFilter context (OrPredicate expr1 expr2) = do

336+predicateRestrictionFilter context attrs (OrPredicate expr1 expr2) = do

338− expr1v <- predicateRestrictionFilter context expr1

337+ expr1v <- predicateRestrictionFilter context attrs expr1

339− expr2v <- predicateRestrictionFilter context expr2

338+ expr2v <- predicateRestrictionFilter context attrs expr2

340 return $ \x -> expr1v x || expr2v x

339 return $ \x -> expr1v x || expr2v x

341

340

342−predicateRestrictionFilter _ TruePredicate = Right $ \_ -> True

341+predicateRestrictionFilter _ _ TruePredicate = Right $ \_ -> True

343

342

344−predicateRestrictionFilter context (NotPredicate expr) = do

343+predicateRestrictionFilter context attrs (NotPredicate expr) = do

345− exprv <- predicateRestrictionFilter context expr

344+ exprv <- predicateRestrictionFilter context attrs expr

346 return $ \x -> not (exprv x)

345 return $ \x -> not (exprv x)

347

346

348−predicateRestrictionFilter context (RelationalExprPredicate relExpr) = case runState (evalRelationalExpr relExpr) context of

347+predicateRestrictionFilter context _ (RelationalExprPredicate relExpr) = case runState (evalRelationalExpr relExpr) context of

349 (Left err, _) -> Left err

348 (Left err, _) -> Left err

350 (Right rel, _) -> if rel == relationTrue then

349 (Right rel, _) -> if rel == relationTrue then

351 Right $ \_ -> True

350 Right $ \_ -> True

@@ -354,12 +353,22 @@ predicateRestrictionFilter context (RelationalExprPredicate relExpr) = case runS

354 else

353 else

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

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

356

355

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

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

358 Left _ -> False

357 Left _ -> False

359 Right atomIn ->

358 Right atomIn ->

360 case evalAtomExpr tupleIn context atomexpr of

359 case evalAtomExpr tupleIn context atomexpr of

361 Left _ -> False

360 Left _ -> False

362 Right atomCmp -> atomCmp == atomIn

361 Right atomCmp -> atomCmp == atomIn

362+

363+-- in the future, it would be useful to do typechecking on the attribute and atom expr filters in advance

364+predicateRestrictionFilter context attrs (AtomExprPredicate atomExpr) = do

365+ aType <- typeFromAtomExpr attrs context atomExpr

366+ if aType /= BoolAtomType then

367+ Left $ AtomTypeMismatchError aType BoolAtomType

368+ else

369+ Right (\tupleIn -> case evalAtomExpr tupleIn context atomExpr of

370+ Left _ -> False

371+ Right boolAtomValue -> boolAtomValue == BoolAtom True)

363

372

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

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

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

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

@@ -445,6 +454,30 @@ basicAtomFunctions = HS.fromList [

445 atomFunc = (\((RelationAtom relIn):_) -> relationMax relIn)},

454 atomFunc = (\((RelationAtom relIn):_) -> relationMax relIn)},

446 AtomFunction { atomFuncName = "min",

455 AtomFunction { atomFuncName = "min",

447 atomFuncType = foldAtomFuncType IntAtomType IntAtomType,

456 atomFuncType = foldAtomFuncType IntAtomType IntAtomType,

448− atomFunc = (\((RelationAtom relIn):_) -> relationMin relIn)}

457+ atomFunc = (\((RelationAtom relIn):_) -> relationMin relIn)},

449−

458+ AtomFunction { atomFuncName = "lt",

459+ atomFuncType = [IntAtomType, IntAtomType, BoolAtomType],

460+ atomFunc = intAtomFuncLessThan False},

461+ AtomFunction { atomFuncName = "lte",

462+ atomFuncType = [IntAtomType, IntAtomType, BoolAtomType],

463+ atomFunc = intAtomFuncLessThan True},

464+ AtomFunction { atomFuncName = "gte",

465+ atomFuncType = [IntAtomType, IntAtomType, BoolAtomType],

466+ atomFunc = boolAtomNot . (:[]) . intAtomFuncLessThan False},

467+ AtomFunction { atomFuncName = "gt",

468+ atomFuncType = [IntAtomType, IntAtomType, BoolAtomType],

469+ atomFunc = boolAtomNot . (:[]) . intAtomFuncLessThan True},

470+ AtomFunction { atomFuncName = "not",

471+ atomFuncType = [BoolAtomType, BoolAtomType],

472+ atomFunc = boolAtomNot}

450 ]

473 ]

474+

475+intAtomFuncLessThan :: Bool -> [Atom] -> Atom

476+intAtomFuncLessThan equality (iatom1:iatom2:_) = (\(IntAtom i1) (IntAtom i2) -> BoolAtom $ i1 `op` i2) iatom1 iatom2

477+ where

478+ op = if equality then (<=) else (<)

479+intAtomFuncLessThan _ _= BoolAtom False

480+

481+boolAtomNot :: [Atom] -> Atom

482+boolAtomNot (BoolAtom bool:_) = BoolAtom $ not bool

483+boolAtomNot _ = BoolAtom False

TutorialD/Interpreter/Base.hs+15−1

@@ -1,6 +1,7 @@

1{-# LANGUAGE OverloadedStrings #-}

2module TutorialD.Interpreter.Base where

3import Text.Parsec

4+import Text.Parsec.String

4import qualified Text.Parsec.Token as Token

5import qualified Text.Parsec.Token as Token

5import Text.Parsec.Language

6import Text.Parsec.Language

6import ProjectM36.Base

7import ProjectM36.Base

@@ -16,13 +17,26 @@ lexer = Token.makeTokenParser tutD

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

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

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

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

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

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

19−

20+

21+parens :: Parser a -> Parser a

20parens = Token.parens lexer

22parens = Token.parens lexer

23+

24+reservedOp :: String -> Parser ()

21reservedOp = Token.reservedOp lexer

25reservedOp = Token.reservedOp lexer

26+

27+reserved :: String -> Parser ()

22reserved = Token.reserved lexer

28reserved = Token.reserved lexer

29+

30+braces :: Parser a -> Parser a

23braces = Token.braces lexer

31braces = Token.braces lexer

32+

33+identifier :: Parser String

24identifier = Token.identifier lexer

34identifier = Token.identifier lexer

35+

36+comma :: Parser String

25comma = Token.comma lexer

37comma = Token.comma lexer

38+

39+semi :: Parser String

26semi = Token.semi lexer

40semi = Token.semi lexer

28--convert Tutorial D type to AtomType

42--convert Tutorial D type to AtomType

TutorialD/Interpreter/RelationalExpr.hs+19−2

@@ -13,6 +13,7 @@ import ProjectM36.Atom

13import qualified Data.Vector as V

14import qualified Data.Set as S

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

16+import Data.Functor.Identity (Identity)

17--used in projection

18--used in projection

18attributeListP :: Parser [AttributeName]

19attributeListP :: Parser [AttributeName]

@@ -142,6 +143,7 @@ summaryP = do

142 return (expr, T.pack attrName)

143 return (expr, T.pack attrName)

143-}

144-}

144

145

146+relOperators :: [[Operator String () Identity RelationalExpr]]

145relOperators = [

147relOperators = [

146 [Postfix projectP],

148 [Postfix projectP],

147 [Postfix renameP],

149 [Postfix renameP],

@@ -174,14 +176,16 @@ restrictionPredicateP = buildExpressionParser predicateOperators predicateTerm

174 [Infix (reservedOp "or" >> return OrPredicate) AssocLeft]

176 [Infix (reservedOp "or" >> return OrPredicate) AssocLeft]

175 ]

177 ]

176 predicateTerm = parens restrictionPredicateP

178 predicateTerm = parens restrictionPredicateP

179+ <|> try restrictionAtomExprP

177 <|> try restrictionAttributeEqualityP

180 <|> try restrictionAttributeEqualityP

178 <|> try relationalBooleanExprP

181 <|> try relationalBooleanExprP

179

182

183+

180relationalBooleanExprP :: Parser RestrictionPredicateExpr

184relationalBooleanExprP :: Parser RestrictionPredicateExpr

181relationalBooleanExprP = do

185relationalBooleanExprP = do

182 relexpr <- relExprP

186 relexpr <- relExprP

183 return $ RelationalExprPredicate relexpr

187 return $ RelationalExprPredicate relexpr

184−

188+

185restrictionAttributeEqualityP :: Parser RestrictionPredicateExpr

189restrictionAttributeEqualityP :: Parser RestrictionPredicateExpr

186restrictionAttributeEqualityP = do

190restrictionAttributeEqualityP = do

187 attributeName <- identifier

191 attributeName <- identifier

@@ -189,6 +193,10 @@ restrictionAttributeEqualityP = do

189 atomexpr <- atomExprP

193 atomexpr <- atomExprP

190 return $ AttributeEqualityPredicate (T.pack attributeName) atomexpr

194 return $ AttributeEqualityPredicate (T.pack attributeName) atomexpr

191

195

196+restrictionAtomExprP :: Parser RestrictionPredicateExpr --atoms which are of type "boolean"

197+restrictionAtomExprP = do

198+ _ <- char '^' -- not ideal, but allows me to continue to use a context-free grammar

199+ AtomExprPredicate <$> atomExprP

192

200

193multiTupleExpressionP :: Parser [TupleExpr]

201multiTupleExpressionP :: Parser [TupleExpr]

194multiTupleExpressionP = sepBy tupleExpressionP comma

202multiTupleExpressionP = sepBy tupleExpressionP comma

@@ -216,7 +224,7 @@ attributeAtomExprP = do

216 return $ AttributeAtomExpr (T.pack attrName)

224 return $ AttributeAtomExpr (T.pack attrName)

217

225

218nakedAtomExprP :: Parser AtomExpr

226nakedAtomExprP :: Parser AtomExpr

219−nakedAtomExprP = NakedAtomExpr <$> (stringAtomP <|> intAtomP)

227+nakedAtomExprP = NakedAtomExpr <$> (stringAtomP <|> intAtomP <|> boolAtomP)

220

228

221functionAtomExprP :: Parser AtomExpr

229functionAtomExprP :: Parser AtomExpr

222functionAtomExprP = do

230functionAtomExprP = do

@@ -227,11 +235,20 @@ functionAtomExprP = do

227relationalAtomExprP :: Parser AtomExpr

235relationalAtomExprP :: Parser AtomExpr

228relationalAtomExprP = RelationAtomExpr <$> relExprP

236relationalAtomExprP = RelationAtomExpr <$> relExprP

229

237

238+quotedChar :: Parser Char

230quotedChar = noneOf "\""

239quotedChar = noneOf "\""

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

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

232

241

242+stringAtomP :: Parser Atom

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

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

234

244

245+intAtomP :: Parser Atom

235intAtomP = do

246intAtomP = do

236 intstr <- many1 digit

247 intstr <- many1 digit

237 return $ IntAtom (read intstr)

248 return $ IntAtom (read intstr)

249+

250+boolAtomP :: Parser Atom

251+boolAtomP = do

252+ val <- char 't' <|> char 'f'

253+ return $ BoolAtom (val == 't')

254+

benchmark/bigrel.hsmode 100644 → 100755+3−1

@@ -15,6 +15,7 @@ import Options.Applicative

15import qualified Data.Map as M

16import qualified Data.Text.IO as TIO

17import System.IO

18+import Control.Monad.State

19dumpcsv :: Relation -> IO ()

20dumpcsv :: Relation -> IO ()

20dumpcsv = BS.putStrLn . relationAsCSV

21dumpcsv = BS.putStrLn . relationAsCSV

@@ -57,7 +58,8 @@ matrixRun (BigrelArgs attributeCount tupleCount tutd) = do

57 putStrLn "Done."

58 putStrLn "Done."

58 else do

59 else do

59 let setx = Assign "x" (ExistingRelation rel)

60 let setx = Assign "x" (ExistingRelation rel)

61+ context = execState (evalContextExpr setx) dateExamples

60− interpreted = interpretDatabaseExpr dateExamples tutd

62+ interpreted = interpretDatabaseExpr context tutd

61 case interpreted of

63 case interpreted of

62 Right context' -> TIO.putStrLn $ relationAsHTML ((relationVariables context') M.! "x")

64 Right context' -> TIO.putStrLn $ relationAsHTML ((relationVariables context') M.! "x")

63 Left err -> hPutStrLn stderr (show err)

65 Left err -> hPutStrLn stderr (show err)

project-m36.cabalmode 100644 → 100755+1−1

@@ -7,7 +7,7 @@ Category: Relational Algebra

7Cabal-Version: >= 1.2

9Library

10− Build-Depends: base,mtl,containers,unordered-containers,parsec,hashable,haskeline,directory,uuid,cassava,text,bytestring,deepseq,deepseq-generics,vector,parallel,monad-parallel

10+ Build-Depends: base,mtl,containers,unordered-containers,parsec,hashable,haskeline,directory,uuid,cassava,text,bytestring,deepseq,deepseq-generics,vector,parallel,monad-parallel,transformers

11 Exposed-Modules: ProjectM36.Error,

12 ProjectM36.Transaction,

13 ProjectM36.Transaction.Show,

test/TutorialD/Interpreter.hs+7−1

@@ -74,7 +74,13 @@ main = do

74 ("x:=(SP group ({S#} as y)) ungroup y", Right supplierProductsRel),

75 ("x:=((SP{S#,QTY}) group ({QTY} as x):{z:=max(@x)}){S#,z}", mkRelationFromList minMaxAttrs (map (\(s,i) -> [StringAtom s,IntAtom i]) [("S1", 400), ("S2", 400), ("S3", 200), ("S4", 400)])),

76 ("x:=((SP{S#,QTY}) group ({QTY} as x):{z:=min(@x)}){S#,z}", mkRelationFromList minMaxAttrs (map (\(s,i) -> [StringAtom s,IntAtom i]) [("S1", 100), ("S2", 300), ("S3", 200), ("S4", 200)])),

77− ("x:=((SP{S#,QTY}) group ({QTY} as x):{z:=sum(@x)}){S#,z}", mkRelationFromList minMaxAttrs (map (\(s,i) -> [StringAtom s,IntAtom i]) [("S1", 1000), ("S2", 700), ("S3", 200), ("S4", 900)]))

77+ ("x:=((SP{S#,QTY}) group ({QTY} as x):{z:=sum(@x)}){S#,z}", mkRelationFromList minMaxAttrs (map (\(s,i) -> [StringAtom s,IntAtom i]) [("S1", 1000), ("S2", 700), ("S3", 200), ("S4", 900)])),

78+ --boolean function restriction

79+ ("x:=S where ^lt(@STATUS,20)", mkRelationFromList (attributes suppliersRel) [[StringAtom "S2", StringAtom "Jones", IntAtom 10, StringAtom "Paris"]]),

80+ ("x:=S where ^gt(@STATUS,20)", mkRelationFromList (attributes suppliersRel) [[StringAtom "S3", StringAtom "Blake", IntAtom 30, StringAtom "Paris"],

81+ [StringAtom "S5", StringAtom "Adams", IntAtom 30, StringAtom "Athens"]]),

82+ ("x:=S where ^sum(@STATUS)", Left $ AtomTypeMismatchError IntAtomType BoolAtomType),

83+ ("x:=S where ^not(gte(@STATUS,20))", mkRelationFromList (attributes suppliersRel) [[StringAtom "S2", StringAtom "Jones", IntAtom 10, StringAtom "Paris"]])

78 ]

84 ]