1 -- 2 -- Representation of Prolog Terms, Clauses and Databases 3 -- Mark P. Jones November 1990 4 -- 5 -- uses Haskell B. version 0.99.3 6 -- 7 -- partain: some changes taken from Hugs 1.0 demo version 8 -- 9 module PrologData(Id, Atom, Term(..), term, termlist, varsIn, 10 Clause((:==)), clause, 11 Database, emptyDb, renClauses, addClause, Parser ) where 12 13 import Parse 14 import List(nub)--1.3 15 import Char(isAlpha,isDigit,isUpper) 16 17 infix 6 :== 18 19 --- Prolog Terms: 20 21 type Id = (Int,String) 22 type Atom = String 23 data Term = Var Id | Struct Atom [Term] 24 data Clause = Term :== [Term] 25 data Database = Db [(Atom,[Clause])] 26 27 instance Eq Term where 28 Var v == Var w = v==w 29 Struct a ts == Struct b ss = a==b && ts==ss 30 _ == _ = False 31 32 --- Determine the list of variables in a term: 33 34 varsIn :: Term -> [Id] 35 varsIn (Var i) = [i] 36 varsIn (Struct i ts) = (nub . concat . map varsIn) ts 37 38 renameVars :: Int -> Term -> Term 39 renameVars lev (Var (n,s)) = Var (lev,s) 40 renameVars lev (Struct s ts) = Struct s (map (renameVars lev) ts) 41 42 --- Functions for manipulating databases (as an abstract datatype) 43 44 emptyDb :: Database 45 emptyDb = Db [] 46 47 renClauses :: Database -> Int -> Term -> [Clause] 48 renClauses db n (Var _) = [] 49 renClauses db n (Struct a _) = [ r tm:==map r tp | (tm:==tp)<-clausesFor a db ] 50 where r = renameVars n 51 52 clausesFor :: Atom -> Database -> [Clause] 53 clausesFor a (Db rss) = case dropWhile (\(n,rs) -> n<a) rss of 54 [] -> [] 55 ((n,rs):_) -> if a==n then rs else [] 56 57 addClause (Db rss) r@(Struct a _ :== _) 58 = Db (update rss) 59 where update [] = [(a,[r])] 60 update (h@(n,rs):rss') 61 | n==a = (n,rs++[r]) : rss' 62 | n<a = h : update rss' 63 | otherwise = (a,[r]) : h : rss' 64 65 --- Output functions (defined as instances of Text): 66 67 instance Show Term where 68 showsPrec p (Var (n,s)) 69 | n==0 = showString s 70 | otherwise = showString s . showChar '_' . shows n 71 showsPrec p (Struct a []) = showString a 72 showsPrec p (Struct a ts) = showString a . showChar '(' 73 . showWithSep "," ts 74 . showChar ')' 75 76 instance Show Clause where 77 showsPrec p (t:==[]) = shows t . showChar '.' 78 showsPrec p (t:==gs) = shows t . showString ":==" 79 . showWithSep "," gs 80 . showChar '.' 81 82 instance Show Database where 83 showsPrec p (Db []) = showString "-- Empty Database --\n" 84 showsPrec p (Db rss) = foldr1 (\u v-> u . showChar '\n' . v) 85 [ showWithTerm "\n" rs | (i,rs)<-rss ] 86 87 --- Local functions for use in defining instances of Text: 88 89 showWithSep :: Show a => String -> [a] -> ShowS 90 showWithSep s [x] = shows x 91 showWithSep s (x:xs) = shows x . showString s . showWithSep s xs 92 93 showWithTerm :: Show a => String -> [a] -> ShowS 94 showWithTerm s xs = foldr1 (.) [shows x . showString s | x<-xs] 95 96 --- String parsing functions for Terms and Clauses: 97 --- Local definitions: 98 99 letter :: Parser Char 100 letter = sat (\c -> isAlpha c || isDigit c || c `elem` ":;+=-*&%$#@?/.~!") 101 102 variable :: Parser Term 103 variable = sat isUpper `seQ` many letter `doo` makeVar 104 where makeVar (initial,rest) = Var (0,(initial:rest)) 105 106 struct :: Parser Term 107 struct = many letter `seQ` (sptok "(" `seQ` termlist `seQ` sptok ")" 108 `doo` (\(o,(ts,c))->ts) 109 `orelse` 110 okay []) 111 `doo` (\(name,terms)->Struct name terms) 112 113 --- Exports: 114 115 term :: Parser Term 116 term = sp (variable `orelse` struct) 117 118 termlist :: Parser [Term] 119 termlist = listOf term (sptok ",") 120 121 clause :: Parser Clause 122 clause = sp struct `seQ` (sptok ":==" `seQ` listOf term (sptok ",") 123 `doo` (\(from,body)->body) 124 `orelse` okay []) 125 `seQ` sptok "." 126 `doo` (\(head,(goals,dot))->head:==goals) 127 128 --- End of PrologData.hs