fdilke/pyrites
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

simplified addFact

Browse Source
This commit is contained in:
Felix Dilke 2026-01-30 14:22:46 +00:00
parent b8db9477c0
commit 2f911a9f39
1 changed files with 3 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
haskell-experiments/src/Datalog/NaiveDatabase.hs
View File

@ -16,9 +16,7 @@ import Data.Maybe
import Data.Set (Set) import Data.Set (Set)
import Data.Set qualified as Set import Data.Set qualified as Set
import Data.Text (Text) import Data.Text (Text)
import Data.Void import Datalog.DatalogParser (Literal (..), Statement (..), Term (..), parseDatalog)
import Datalog.DatalogParser (Head (HeadSingle), Literal (..), Statement (..), Term (..), parseDatalog)
import Text.Megaparsec (ParseErrorBundle)
import Datalog.Rules import Datalog.Rules
import Datalog.DatalogDB import Datalog.DatalogDB
@ -47,12 +45,11 @@ instance DatalogDB NaiveDatabase where
addFact :: Literal -> NaiveDatabase -> NaiveDatabase addFact :: Literal -> NaiveDatabase -> NaiveDatabase
addFact (Literal neg relationName terms) db@(NaiveDatabase relationMap constantSet) = addFact (Literal neg relationName terms) db@(NaiveDatabase relationMap constantSet) =
NaiveDatabase newRelationMap newConstantSet insertRelation (addConstants db extraConstants) newRelation
where where
newArity = length terms newArity = length terms
newRelation = lookupRelation0 relationName db newArity (Set.singleton terms) newRelation = lookupRelation0 relationName db newArity (Set.singleton terms)
newRelationMap = Map.insert relationName newRelation relationMap extraConstants = Set.fromList terms
newConstantSet = Set.union constantSet $ Set.fromList terms
addRule :: (Literal, [Literal]) -> NaiveDatabase -> NaiveDatabase addRule :: (Literal, [Literal]) -> NaiveDatabase -> NaiveDatabase
addRule (ruleHead, body) db = addRule (ruleHead, body) db =