Commit 24f3072b authored by Paul Ogris's avatar Paul Ogris
Browse files

Work towards aggregates

parent 83ce2cc9
......@@ -93,12 +93,14 @@ instance Pretty Head where
instance IsString Head where
fromString s = HeadAtom (pack s)
data BodyElement = BodyAtom SignedAtom | BodyRelation Relation
data BodyElement
= BodyAtom SignedAtom
| BodyRelation Relation
deriving (Eq, Show, Ord, Read)
instance Pretty BodyElement where
pretty (BodyAtom x) = PP.pretty x
pretty (BodyRelation x) = PP.textStrict x
pretty (BodyAtom x) = PP.pretty x
pretty (BodyRelation x) = PP.textStrict x
data SignedAtom = Positive Atom | Negative Atom
deriving (Eq, Show, Ord, Read)
......@@ -133,7 +135,7 @@ symbol = L.symbol sc
atom :: Parser Atom
atom = lexeme $ do
identifier <-
pack <$> ((:) <$> (P.char '-' <|> P.lowerChar) <*> many P.alphaNumChar)
pack <$> ((:) <$> (P.char '-' <|> P.lowerChar) <*> many (P.alphaNumChar <|> P.char '_'))
arguments <- option "" . lexeme $ do
_ <- P.char '('
args <- takeWhileP Nothing (/= ')')
......@@ -149,8 +151,12 @@ head_ :: Parser Head
head_ = (HeadAtom <$> atom) <|> choice_ <|> pure HeadFalse
where
choice_ = do
l <- optional (lexeme L.decimal)
(set, conditions) <- between openBrace closeBrace $ (,) <$> choiceList <*> option [] choiceCondition
l <- optional (lexeme L.decimal)
(set, conditions) <-
between openBrace closeBrace
$ (,)
<$> choiceList
<*> option [] choiceCondition
u <- optional (lexeme L.decimal)
pure $ HeadChoice l set conditions u
choiceList = fromList <$> atom `sepBy1` semicolon
......@@ -160,7 +166,9 @@ ruleIf :: Parser Text
ruleIf = symbol ":-"
bodyElement :: Parser BodyElement
bodyElement = (BodyAtom <$> signedAtom) <|> (BodyRelation <$> relation)
bodyElement =
(BodyAtom <$> signedAtom)
<|> (BodyRelation <$> relation)
comma :: Parser Text
comma = symbol ","
......
......@@ -21,6 +21,6 @@ relax = map normalRules . concatMap splitChoices . filter (not . isConstraint)
isConstraint _ = False
removeNegation :: BodyElement -> Maybe BodyElement
removeNegation (BodyAtom (Negative _)) = Nothing
removeNegation (BodyAtom (Positive x)) = Just (BodyAtom (Positive x))
removeNegation (BodyRelation r ) = Just (BodyRelation r)
removeNegation (BodyAtom (Negative _)) = Nothing
removeNegation (BodyAtom (Positive x)) = Just (BodyAtom (Positive x))
removeNegation (BodyRelation r ) = Just (BodyRelation r)
......@@ -112,3 +112,6 @@ parser = parallel $ do
it "parses constraints" $ parse rule "" ":- a." `shouldParse` Rule
HeadFalse
[BodyAtom (Positive "a")]
it "parses aggregates"
$ parse bodyElement "" "#count { a(X) : b(X) }"
`shouldParse` BodyRelation "#count { a(X) : b(X) }"
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment