rearranging modules

This commit is contained in:
Felix Dilke 2026-01-30 10:27:26 +00:00
parent f7d89f89c9
commit b997ee635e
4 changed files with 45 additions and 27 deletions

View File

@ -93,6 +93,7 @@ library langfeatures
Datalog.DatalogParser Datalog.DatalogParser
Datalog.NaiveDatabase Datalog.NaiveDatabase
Datalog.Rules Datalog.Rules
Datalog.DatalogDB
ghc-options: -Wall ghc-options: -Wall
default-extensions: default-extensions:
OverloadedStrings OverloadedStrings

View File

@ -0,0 +1,25 @@
{-# HLINT ignore "Redundant flip" #-}
{-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
module Datalog.DatalogDB where
import Control.Exception.Base
import Data.List
import Data.Map (Map)
import Data.Map qualified as Map
import Data.Maybe
import Data.Set (Set)
import Data.Set qualified as Set
import Data.Text (Text)
import Data.Void
import Datalog.DatalogParser (Head (HeadSingle), Literal (..), Statement (..), Term (..), parseDatalog)
import Text.Megaparsec (ParseErrorBundle)
import Datalog.Rules
class DatalogDB db where
emptyDB :: db
lookupRelation :: db -> Text -> Maybe Relation
insertRelation :: db -> Relation -> db

View File

@ -20,6 +20,7 @@ import Data.Void
import Datalog.DatalogParser (Head (HeadSingle), Literal (..), Statement (..), Term (..), parseDatalog) import Datalog.DatalogParser (Head (HeadSingle), Literal (..), Statement (..), Term (..), parseDatalog)
import Text.Megaparsec (ParseErrorBundle) import Text.Megaparsec (ParseErrorBundle)
import Datalog.Rules import Datalog.Rules
import Datalog.DatalogDB
data NaiveDatabase = NaiveDatabase data NaiveDatabase = NaiveDatabase
{ relations :: Map RelationId Relation { relations :: Map RelationId Relation
@ -95,11 +96,6 @@ withFacts =
newRelationMap = Map.insert relationName newRelation relationMap newRelationMap = Map.insert relationName newRelation relationMap
newConstantSet = Set.union constantSet $ Set.fromList terms newConstantSet = Set.union constantSet $ Set.fromList terms
data BodyConstraint = BodyConstraint
{ _subRelation :: Relation
, _elements :: [RuleElement]
}
data RuleContext = RuleContext data RuleContext = RuleContext
{ __relation :: Relation { __relation :: Relation
, _variableNames :: [Text] , _variableNames :: [Text]
@ -108,24 +104,6 @@ data RuleContext = RuleContext
, _db :: NaiveDatabase , _db :: NaiveDatabase
} }
appendRule :: Relation -> RelationRule -> Relation
appendRule relation rule =
relation {
_rules = rule : (_rules relation)
}
-- Relation { _name = _name relation
-- , _arity = _arity relation
-- , _tuples = _tuples relation
-- , _rules = rule : (_rules relation)
-- }
toRuleBodyElement :: BodyConstraint -> RuleBodyElement
toRuleBodyElement (BodyConstraint subRelation elements) =
RuleBodyElement {
_subRelationId = _name subRelation
, _ruleElements = elements
}
withFactsAndRules :: [Text] -> [Text] -> NaiveDatabase withFactsAndRules :: [Text] -> [Text] -> NaiveDatabase
withFactsAndRules facts = foldr (addRule . extractRule) (withFacts facts) withFactsAndRules facts = foldr (addRule . extractRule) (withFacts facts)
where where

View File

@ -47,7 +47,21 @@ data Relation = Relation
type Constant = Term type Constant = Term
type RelationId = Text type RelationId = Text
class DatalogDB db where data BodyConstraint = BodyConstraint
emptyDB :: db { _subRelation :: Relation
lookupRelation :: db -> Text -> Maybe Relation , _elements :: [RuleElement]
insertRelation :: db -> Relation -> db }
appendRule :: Relation -> RelationRule -> Relation
appendRule relation rule =
relation {
_rules = rule : (_rules relation)
}
toRuleBodyElement :: BodyConstraint -> RuleBodyElement
toRuleBodyElement (BodyConstraint subRelation elements) =
RuleBodyElement {
_subRelationId = _name subRelation
, _ruleElements = elements
}