diff --git a/datalog/src/Datalog/Parser.hs b/datalog/src/Datalog/Parser.hs index 766c4a2..506a16a 100644 --- a/datalog/src/Datalog/Parser.hs +++ b/datalog/src/Datalog/Parser.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE MultilineStrings #-} + module Datalog.Parser ( parseTerm , parseAtom @@ -14,6 +16,7 @@ import Data.Void (Void) import Text.Megaparsec import Text.Megaparsec.Char import Text.Megaparsec.Char.Lexer qualified as L +import Text.Pretty.Simple type Parser = Parsec Void Text @@ -58,14 +61,44 @@ parseFact :: Parser Rule parseFact = do headAtom <- parseAtom period - return (headAtom :- []) + return (Rule () headAtom []) parseRule :: Parser Rule parseRule = try parseFact <|> do headAtom <- parseAtom <* symbol ":-" bodyAtoms <- parseQuery period - return (headAtom :- bodyAtoms) + return (Rule () headAtom bodyAtoms) parseProgram :: Parser Program parseProgram = Program () <$> many parseRule + +annotateSrcLoc :: Functor f => Parser (f a) -> Parser (f SrcLoc) +annotateSrcLoc p = do + s <- getSourcePos + res <- p + f <- getSourcePos + pure (SrcLoc s f <$ res) + +data SrcLoc = SrcLoc + { start :: SourcePos + , end :: SourcePos + } deriving Show + +test = do + let r = runParser parseProgram "???" prog + pPrint @IO r + +prog = """ + odd(X,Y) :- r(X,Y). + odd(X,Y) :- even(X,Z), r(Z,Y). + even(X,Y) :- odd(X,Z), r(Z,Y). + + r(0,1). + r(1,2). + r(2,3). + r(3,4). + r(4,5). + + r(X,Y) :- r(Y,X). + """