From 42655b90f558fd82c4497325ae4bbb5b29e6f21a Mon Sep 17 00:00:00 2001 From: George Thomas Date: Mon, 2 Mar 2026 17:21:26 +0000 Subject: [PATCH] wip - have fun --- datalog/src/Datalog/Parser.hs | 58 ++++++++++++++++++++++++++--------- geolog-lsp.cabal | 3 +- 2 files changed, 46 insertions(+), 15 deletions(-) diff --git a/datalog/src/Datalog/Parser.hs b/datalog/src/Datalog/Parser.hs index 766c4a2..69ee131 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 @@ -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). + """ diff --git a/geolog-lsp.cabal b/geolog-lsp.cabal index 34051d5..c4968c0 100644 --- a/geolog-lsp.cabal +++ b/geolog-lsp.cabal @@ -26,7 +26,8 @@ library datalog-parser base, text, containers, - megaparsec + megaparsec, + pretty-simple, exposed-modules: Datalog.Parser, Datalog.Syntax