-- Representation of Prolog Terms, Clauses and Databases -- Adaptation from Mark P. Jones November 1990, modified for Gofer 20th July 1991, -- and for Hugs 1.3 June 1996. -- Made by G.Naudts January 2003 -- Suitable for use with Python 2.2 -- module RDFProlog where import List import CombParse import TripleData import Utils import ToN3 import SubAnons import N3Unify import N3Engine infix 6 :> --data Triple = Triple (Subject, Predicate, Object) | Rule Rule | TripleNil -- deriving (Show, Eq) --type Subject = Resource --type Predicate = Resource --type Object = Resource --data Resource = URI String | Literal String | TripleSet TripleSet | -- Var Vare | ResNil -- deriving (Show,Eq) --type TripleSet = [Triple] --data Vare = UVar String | EVar String | GVar String | GEVar String -- deriving (Show,Eq) --type DB = [TripleSet] --type Query = [TripleSet] -- rules are numbered. This is done for anti-looping. --type Rule= (Antecedents, Consequent, Int) --type Antecedents = TripleSet --type Consequent = TripleSet --- Prolog Terms: type Id = String type Atom = String data Term = VarP Id | Struct Atom [Term] deriving (Show, Eq) data Clause = [Term] :> [Term] deriving (Show, Eq) data Database = Db [(Atom,[Clause])] deriving (Show,Eq) -- testdata var1 = VarP "X" struct1 = Struct "Ter" [var1,Struct "t1" [], Struct "t2" []] struct2 = Struct "ter1" [var1,Struct "t12" [], Struct "t22" []] struct3 = Struct "ter2" [var1,Struct "t13" [], Struct "t23" []] struct4 = Struct "ter3" [var1,Struct "t14" [], Struct "t24" []] clause1 = [struct1,struct2] :> [struct3, struct4] clause2 = [struct1,struct4] :> [] db = [clause1, clause2] rdfType = " (DB, Int, Int, Int) transDB ([], nr1, nr2, nr3) = ([], nr1, nr2, nr3) transDB ((d:ds), nr1, nr2, nr3) = (d1:dbO, nr12, nr22, nr32) where (d1, nr11, nr21, nr31) = transClause (d, nr1, nr2, nr3) (dbO, nr12, nr22, nr32) = transDB (ds, nr11, nr21, nr31) testTransVarP = show(transVarP var1) transVarP (VarP id) = Var (UVar (id ++ " " ++ id)) testTransClause = tripleSetToN3(first4(transClause (clause1, 1, 1, 1))) first4 (a,b,c, d) = a first2 (a, b) = a -- the first number is for the anonymous subject. -- the second number is for numbering rules -- the third number is for numbering variables -- transforms a clause in prolog style to triples transClause :: (Clause, Int, Int, Int) -> (TripleSet, Int, Int, Int) transClause ((terms1 :> terms2), nr1, nr2, nr3) |bv1 = (tsO, nr11, nr21, nr31) |otherwise = ([Rule (tsO, ts1O, nr2)], nr12, nr21, nr31) where bv1 = length terms2 == 0 (ts, nr11) = transTerms (terms1, nr1) (ts1, nr12) = transTerms (terms2, nr11) nr21 = nr2 + 1 tsO = numVars ts nr3 ts1O = numVars ts1 nr3 nr31 = nr3 + 1 numVars :: TripleSet -> Int -> TripleSet numVars ts nr = map (numTriple nr) ts where numTriple nr (Triple(s,p,o)) = Triple(numRes s nr, numRes p nr, numRes o nr) numRes (Var (UVar v)) nr = Var (UVar (s ++ " " ++ s1)) where s = ("_" ++ intToString nr) ++ "?" ++ getStringPart (UVar v) s1 = "?" ++ getStringPart (UVar v) numRes a nr = a getStringPart (UVar s) = third (parseUntil ' ' s ) third (a, b, c) = c testTransTerms = tripleSetToN3 (first2(transTerms ([struct1,struct2], 1))) -- the first number is for the anonymous subject. transTerms :: ([Term], Int) -> (TripleSet, Int) transTerms ([], nr1) = ([], nr1) transTerms ((t:ts), nr1) |bv1 = error ("Invalid format: transTerms " ++ show t) |otherwise = (t1 ++ t2, nr12) where (t1, nr11) = transStruct (t, nr1) (t2, nr12) = transTerms (ts, nr11) bv1 = testT t testT (VarP id) = True testT t = False testTransStruct = (tripleSetToN3 (first2(transStruct (struct1, 1)))) -- the first number is for the anonymous subject. transStruct :: (Term, Int) -> (TripleSet, Int) transStruct ((Struct atom terms), nr1) |bv3 = ([Triple(subject,subject,object)],nr12) |bv1 = ([Triple(p, object, o)], nr1) |bv2 = ([Triple(subject, object, o1)],nr12) |otherwise = (ts1, nr12) where subject = Var (EVar (varV ++ " " ++ varV)) varV = "T$$$" ++ (intToString nr1) property = URI ("a " ++ rdfType) (t:ts) = terms object = makeObject atom makeObject (x:xs) |isUpper x = Var (UVar (atom ++ " " ++ atom)) |otherwise = URI (":" ++ atom ++ " :" ++ atom) triple = Triple(subject, property, object) nr12 = nr1 + 1 ts1 = makeTerms terms subject atom bv1 = length terms == 2 -- a real triple makeTwo (x:(y:ys)) = (makeRes x, makeRes y) (p, o) = makeTwo terms bv2 = length terms == 1 -- a unary predicate (x1:xs1) = terms o1 = makeRes x1 bv3 = length terms == 0 -- a fact -- returns a triple set. makeTerms terms subject atom = makeTermsH terms subject 1 atom where makeTermsH [] subject nr atom = [] makeTermsH (t:ts) subject nr atom = triple:makeTermsH ts subject nr1 atom where property = URI (pVal ++ " " ++ pVal) pVal = ":" ++ atom ++ "_" ++ intToString nr nr1 = nr + 1 object = makeRes t triple = Triple (subject, property, object) makeRes (VarP id) = transVarP (VarP id) makeRes (Struct atom terms) |not bv1 = error ("invalid format " ++ show (Struct atom terms)) |bv2 = Literal ("Literal " ++ atom1) |otherwise = URI (":" ++ atom ++ " :" ++ atom) where bv1 = (length terms) == 0 bv2 = startsWith atom "\"" (a:as) = atom (_, atom1, _) = parseUntil '"' as --- String parsing functions for Terms and Clauses: --- Local definitions: #letter :: Parser Char letter = (lambda c: self.isAlpha(c) or self.isDigit(c) or self.elem(c,"\"_:;+=-*&%$#@?/.~!") #letter = sat (\c->isAlpha c || isDigit c || c `elem` "\"_:;+=-*&%$#@?/.~!") #variable :: Parser Term variable = (lambda s: self.makeVar(s[0] + self.many(letter,s[:1])) #variable = sat isUpper `pseq` many letter `pam` makeVar # where makeVar (initial,rest) = VarP (initial:rest) struct :: Parser Term struct = many letter `pseq` (sptok "(" `pseq` termlist `pseq` sptok ")" `pam` (\(o,(ts,c))->ts) `orelse` okay []) `pam` (\(name,terms)->Struct name terms) --- Exports: term :: Parser Term term = sp (variable `orelse` struct) termlist :: Parser [Term] termlist = listOf term (sptok ",") clause :: Parser Clause clause = sp (listOf term (sptok ",")) `pseq` (sptok ":>" `pseq` listOf term (sptok ",") `pam` (\(from,body)->body) `orelse` okay []) `pseq` sptok "." `pam` (\(head,(goals,dot))->head:>goals) readN3Pro :: String -> String -> IO() readN3Pro fileName1 fileName2 = do s <- readFile fileName1 let parse = map clause (lines s) clauses = [ r | ((r,""):_) <- parse ] (db, _, _, _) = transDB (clauses, 1, 1, 1) s1 <- readFile fileName2 let parse1 = map clause (lines s1) clauses1 = [ r1 | ((r1,""):_) <- parse1 ] (db1, _, _, _) = transDB (clauses1, 1, 1, 1) putStr (dbToN3 (changeAnons (subgraphTripleSet (concat db) ++ db1))) readN3Pro2 :: String -> String -> IO() readN3Pro2 fileName1 fileName2 = do s <- readFile fileName1 let parse = map clause (lines s) clauses = [ r | ((r,""):_) <- parse ] (db, _, _, _) = transDB (clauses, 1, 1, 1) s1 <- readFile fileName2 let parse1 = map clause (lines s1) clauses1 = [ r1 | ((r1,""):_) <- parse1 ] (db1, _, _, _) = transDB (clauses1, 1, 1, 1) putStr (show (changeAnons (subgraphTripleSet (concat db)) ++ db1)) readN3Pro1 :: String -> String -> IO() readN3Pro1 fileName1 fileName2 = do s <- readFile fileName1 let parse = map clause (lines s) clauses = [ r | ((r,""):_) <- parse ] (db, _, _, _) = transDB (clauses, 1, 1, 1) s1 <- readFile fileName2 let parse1 = map clause (lines s1) clauses1 = [ r1 | ((r1,""):_) <- parse1 ] (db1, _, _, _) = transDB (clauses1, 1, 1, 1) putStr (getDBQueryP (changeAnons (subgraphTripleSet (concat db)) , db1)) changeAnons :: DB -> DB changeAnons [] = [] changeAnons (x:xs) = map changeTriple x: changeAnons xs where changeTriple (Triple(Var (EVar s), p, o)) |containsString "T$$$" s = Triple (URI s, p, o) |otherwise = Triple (Var (EVar s), p, o) changeTriple t = t test = readN3Pro "testPro.n3" "testPro.n3" pr11 = readN3Pro "authen.axiom.pro" "authen.lemma.pro" pr12 = readN3Pro1 "authen.axiom.pro" "authen.lemma.pro" pr21 = readN3Pro "sum.a.pro" "sum.q.pro" pr22 = readN3Pro1 "sum.a.pro" "sum.q.pro" pr31 = readN3Pro "boole.axiom.pro" "boole.lemma.pro" pr32 = readN3Pro1 "boole.axiom.pro" "boole.lemma.pro" pr33 = readN3Pro2 "boole.axiom.pro" "boole.lemma.pro" pr41 = readN3Pro "club.a.pro" "club.q.pro" pr42 = readN3Pro1 "club.a.pro" "club.q.pro" pr51 = readN3Pro "group1.a.pro" "group1.q.pro" pr52 = readN3Pro1 "group1.a.pro" "group1.q.pro" pr61 = readN3Pro "group2.a.pro" "group2.q.pro" pr62 = readN3Pro1 "group2.a.pro" "group2.q.pro" pr63 = readN3Pro2 "group2.a.pro" "group2.q.pro" menuR= let print s = putStr (s ++ "\n") in do print "Type the command = first word." print "Between [] are the used files." print "x1 gives the N3 translation." print "x2 gives the solution." print "pr11 [authen.axiom.pro,authen.lemma.pro]" print "pr12 [authen.axiom.pro,authen.lemma.pro]" print "pr21 [sum.a.pro,sum.q.pro]" print "pr22 [sum.a.pro,sum.q.pro]" print "pr31 [boole.axiom.pro,boole.lemma.pro]" print "pr32 [boole.axiom.pro,boole.lemma.pro]" print "pr41 [club.a.pro,club.q.pro]" print "pr42 [club.a.pro,club.q.pro]" getDBQueryP :: (DB, DB) -> (String) getDBQueryP (dbOut, queryOut) = ((testVerbose "" ("Substitutions:\n\n" ++ substListListToN3 sll)) ++ "\nN3Trace:\n\n" ++ trace ++ solutions) where (sll, trace) = (proof dbOut queryOut ((intToString 0) ++ " ")) solutions = ("\nQuery:\n\n" ++ dbToN3 queryOut ++ getSolutions sll queryOut) getSolutions :: [SubstitutionList] -> [TripleSet] -> String getSolutions [] _ = "" getSolutions (x:xs) queryOut = sol2 ++ getSolutions xs queryOut where sol1 = applySubstitutionListToDB x queryOut sol2 = "\nSolution:\n\n" ++ dbToN3 sol1 --- End of N3Prolog.hs