Compare commits

...

1 Commits

Author SHA1 Message Date
George Thomas
42655b90f5 wip - have fun 2026-03-02 17:21:26 +00:00
2 changed files with 46 additions and 15 deletions

View File

@ -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
@ -36,36 +39,63 @@ comma, period :: (MonadParsec e Text m) => m ()
comma = () <$ symbol ","
period = () <$ symbol "."
parseCon :: (MonadParsec e Text m) => m Term
parseCon = Con () . ConId . T.pack <$> lexeme (liftA2 (:) (numberChar <|> lowerChar) (many alphaNumChar))
parseCon :: (MonadParsec e Text m) => m (Term' SrcLoc)
parseCon = Con dummy . ConId . T.pack <$> lexeme (liftA2 (:) (numberChar <|> lowerChar) (many alphaNumChar))
parseVar :: (MonadParsec e Text m) => m Term
parseVar = Var () . VarId . T.pack <$> lexeme (liftA2 (:) upperChar (many alphaNumChar))
parseVar :: (MonadParsec e Text m) => m (Term' SrcLoc)
parseVar = Var dummy . VarId . T.pack <$> lexeme (liftA2 (:) upperChar (many alphaNumChar))
parseTerm :: Parser Term
parseTerm :: Parser (Term' SrcLoc)
parseTerm = parseVar <|> parseCon
parseAtom :: Parser Atom
parseAtom :: Parser (Atom' SrcLoc)
parseAtom = do
p <- getSourcePos
rel <- RelId . T.pack <$> lexeme (liftA2 (:) lowerChar (many alphaNumChar))
args <- parens (parseTerm `sepBy` comma)
return (Atom () rel args)
return (Atom SrcLoc{start = p} rel args)
parseQuery :: Parser [Atom]
parseQuery :: Parser [Atom' SrcLoc]
parseQuery = parseAtom `sepBy` comma
parseFact :: Parser Rule
parseFact :: Parser (Rule' SrcLoc)
parseFact = do
p <- getSourcePos
headAtom <- parseAtom
period
return (headAtom :- [])
return (Rule SrcLoc{start = p} headAtom [])
parseRule :: Parser Rule
parseRule :: Parser (Rule' SrcLoc)
parseRule = try parseFact <|> do
p <- getSourcePos
headAtom <- parseAtom <* symbol ":-"
bodyAtoms <- parseQuery
period
return (headAtom :- bodyAtoms)
return (Rule SrcLoc{start = p} headAtom bodyAtoms)
parseProgram :: Parser Program
parseProgram = Program () <$> many parseRule
parseProgram :: Parser (Program' SrcLoc)
parseProgram = Program dummy <$> many parseRule
data SrcLoc = SrcLoc
{ start :: SourcePos
-- , end :: (Word, Word)
} deriving Show
dummy = SrcLoc{start = initialPos "dummy-file"}
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).
"""

View File

@ -26,7 +26,8 @@ library datalog-parser
base,
text,
containers,
megaparsec
megaparsec,
pretty-simple,
exposed-modules:
Datalog.Parser,
Datalog.Syntax