wip - have fun
This commit is contained in:
parent
bd080c37aa
commit
42655b90f5
@ -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).
|
||||
"""
|
||||
|
||||
@ -26,7 +26,8 @@ library datalog-parser
|
||||
base,
|
||||
text,
|
||||
containers,
|
||||
megaparsec
|
||||
megaparsec,
|
||||
pretty-simple,
|
||||
exposed-modules:
|
||||
Datalog.Parser,
|
||||
Datalog.Syntax
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user