├── LICENSE ├── Main.hs ├── Prolog.hs ├── README ├── Setup.hs ├── aprolog.cabal ├── demo.prolog ├── note-ja.txt ├── note.html └── test.hs /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2009 Takashi Yamamiya 2 | 3 | Permission is hereby granted, free of charge, to any person obtaining a copy 4 | of this software and associated documentation files (the "Software"), to deal 5 | in the Software without restriction, including without limitation the rights 6 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 7 | copies of the Software, and to permit persons to whom the Software is 8 | furnished to do so, subject to the following conditions: 9 | 10 | The above copyright notice and this permission notice shall be included in 11 | all copies or substantial portions of the Software. 12 | 13 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 14 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 15 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 16 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 17 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 18 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN 19 | THE SOFTWARE. 20 | -------------------------------------------------------------------------------- /Main.hs: -------------------------------------------------------------------------------- 1 | import Prolog 2 | 3 | main = interact start 4 | -------------------------------------------------------------------------------- /Prolog.hs: -------------------------------------------------------------------------------- 1 | -- Copyright (c) 2009 Takashi Yamamiya 2 | 3 | -- Permission is hereby granted, free of charge, to any person obtaining a copy 4 | -- of this software and associated documentation files (the "Software"), to deal 5 | -- in the Software without restriction, including without limitation the rights 6 | -- to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 7 | -- copies of the Software, and to permit persons to whom the Software is 8 | -- furnished to do so, subject to the following conditions: 9 | 10 | -- The above copyright notice and this permission notice shall be included in 11 | -- all copies or substantial portions of the Software. 12 | 13 | -- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 14 | -- IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 15 | -- FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 16 | -- AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 17 | -- LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 18 | -- OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN 19 | -- THE SOFTWARE. 20 | 21 | -- | A prolog interpreter. 22 | module Prolog 23 | (-- * Data structures 24 | Term(..), Clause(..), 25 | -- * Utility constructors for debugging 26 | w, s, cons, 27 | -- * Reader 28 | parse, parse', 29 | atom, variable, struct, list, nil, terms, arguments, term, clause, clauses, query, 30 | -- * Printer 31 | display, 32 | -- * Unification 33 | unify, unifyList, applyTerm, 34 | -- * Solver 35 | prove, rename, 36 | -- * Testing 37 | solveString, start) where 38 | 39 | import Text.ParserCombinators.Parsec 40 | import Data.Maybe (maybeToList) 41 | import Char (isUpper) 42 | 43 | infix 6 :- 44 | data Term = Var String Int | Struct String [Term] deriving (Show, Eq) 45 | data Clause = Term :- [Term] deriving (Show, Eq) 46 | data Command = Fact Clause | Query [Term] | ShowAll | Noop 47 | 48 | type Rules = [Clause] 49 | 50 | -- Utility constructors for debugging 51 | w :: String -> Term 52 | w s@(x:xs) | isUpper x = Var s 0 53 | | otherwise = Struct s [] 54 | 55 | s :: String -> [Term] -> Term 56 | s n xs = Struct n xs 57 | 58 | cons s cdr = (Struct "cons" [w s, cdr]) 59 | 60 | ---- Unification ---- 61 | 62 | type Substitution = [(Term, Term)] 63 | true = [] 64 | 65 | -- | > apply [(w"X", w"Y"), (w"Y", w"Z")] [(w"X"), (w"Y")] == [(w"Z"), (w"Z")] 66 | apply :: Substitution -> [Term] -> [Term] 67 | apply s ts = [applyTerm s t | t <- ts] 68 | 69 | applyTerm [] (Var y n) = Var y n 70 | applyTerm ((Var x i, t):s) (Var y j) | x == y && i == j = applyTerm s t 71 | | otherwise = applyTerm s (Var y j) 72 | applyTerm s (Struct n ts) = Struct n (apply s ts) 73 | 74 | -- | > unify (w"X") (w"apple") == Just [(w"X", w"apple")] 75 | unify :: Term -> Term -> Maybe Substitution 76 | unify (Var x n) (Var y m) = Just [(Var x n, Var y m)] 77 | unify (Var x n) y = Just [(Var x n, y)] 78 | unify x (Var y m) = Just [(Var y m, x)] 79 | unify (Struct a xs) (Struct b ys) 80 | | a == b = unifyList xs ys 81 | | otherwise = Nothing 82 | 83 | unifyList :: [Term] -> [Term] -> Maybe Substitution 84 | unifyList [] [] = Just true 85 | unifyList [] _ = Nothing 86 | unifyList _ [] = Nothing 87 | unifyList (x:xs) (y:ys) = do s <- unify x y 88 | s' <- unifyList (apply s xs) (apply s ys) 89 | return (s ++ s') 90 | 91 | ---- Solver ---- 92 | 93 | prove :: Rules -> [Term] -> [Substitution] 94 | prove rules goals = find rules 1 goals 95 | 96 | -- Depth first search 97 | -- > find (parse' clauses "p(X):-q(X). q(a).") 1 [parse' term "p(X)"] 98 | find :: Rules -> Int -> [Term] -> [Substitution] 99 | find rules i [] = [true] 100 | find rules i goals = do let rules' = rename rules i 101 | (s, goals') <- branch rules' goals 102 | solution <- find rules (i + 1) goals' 103 | return (s ++ solution) 104 | 105 | -- Find next branches. A branch is a pair of substitution and next goals. 106 | -- > branch (parse' clauses "n(z). n(s(X)):-n(X).") (parse' query "?-n(X).") 107 | branch :: Rules -> [Term] -> [(Substitution, [Term])] 108 | branch rules (goal:goals) = do head :- body <- rules 109 | s <- maybeToList (unify goal head) 110 | return (s, apply s (body ++ goals)) 111 | 112 | -- | Rename all variables in the rules to split namespaces. 113 | rename :: Rules -> Int -> Rules 114 | rename rules i = [ renameVar head :- renameVars body | head :- body <- rules] 115 | where renameVar (Var s _) = Var s i 116 | renameVar (Struct s ts) = Struct s (renameVars ts) 117 | renameVars ts = [renameVar t | t <- ts] 118 | 119 | ---- Reader ---- 120 | 121 | -- Spaces are always consumed with the previous token. 122 | 123 | parse' parser s = result where Right result = parse parser "" s 124 | nil = Struct "nil" [] 125 | 126 | schar c = char c >> spaces 127 | special = oneOf ":;+=-*&$#@/.~!" <|> digit 128 | 129 | atom = (lower >>= \x -> many alphaNum >>= \xs -> spaces >> return (x:xs)) <|> 130 | (many1 special >>= \x -> spaces >> return x) 131 | 132 | variable = upper >>= \x -> many alphaNum >>= \xs -> spaces >> return (Var (x:xs) 0) 133 | 134 | struct = atom >>= \name -> arguments >>= \ls -> return (Struct name ls) 135 | 136 | arguments = ((schar '(' >> terms >>= \ls -> schar ')' >> return ls)) <|> 137 | (spaces >> return []) 138 | 139 | list = schar '[' >> terms >>= \ts -> listTail >>= \t -> return (makeList ts t) 140 | where makeList [] cdr = cdr 141 | makeList (x:xs) cdr = Struct "cons" [x, makeList xs cdr] 142 | 143 | listTail = (schar '|' >> term >>= \t -> schar ']' >> return t) <|> 144 | (schar ']' >> return nil) 145 | 146 | term = (variable <|> struct <|> list) >>= \t -> return t 147 | terms = sepBy term (schar ',') 148 | 149 | clause = struct >>= \head -> ((schar '.' >> return (head :- [])) <|> 150 | (query >>= \goals -> return (head :- goals))) 151 | clauses = many clause 152 | 153 | arrow = (char '?' <|> char ':') >> schar '-' 154 | query = arrow >> terms >>= \goals -> schar '.' >> return goals 155 | 156 | noop = (char '%' >> skipMany anyToken) <|> eof 157 | 158 | command :: Parser Command 159 | command = spaces >> 160 | ((clause >>= \c -> return (Fact c)) <|> 161 | try (query >>= \ts -> return (Query ts)) <|> 162 | (string "??" >> return (ShowAll)) <|> 163 | (noop >> return (Noop))) 164 | 165 | -- parse atom "" "atom1234" 166 | -- parse variable "" "Variable1234" 167 | -- parse struct "" "father ( masuo , tara ) " 168 | -- parse arguments "" "( orange , Apple , banana ) " 169 | -- parse list "" "[]" 170 | -- parse list "" "[ 1 , 2 | 3 ] " 171 | -- parse terms "" "orange , apple , banana " 172 | -- parse term "" "someAtom " 173 | -- parse clause "" "child ( X , Y) :- mother( Y, X ) . " 174 | -- parse query "" "?- apple ." 175 | 176 | ---- Printer ---- 177 | 178 | class Display a where 179 | displays :: a -> String -> String 180 | display :: a -> String 181 | display x = displays x "" 182 | 183 | instance Display Term where 184 | displays (Var s 0) = showString s 185 | displays (Var s n) = showString s . showChar '_' . shows n 186 | displays (Struct "nil" []) = showString "[]" 187 | displays (Struct "cons" [h, t]) = showChar '[' . displays h . displaysTail t . showChar ']' 188 | displays (Struct s []) = showString s 189 | displays (Struct s xs) = showString s . showChar '(' . displays xs . showChar ')' 190 | 191 | displaysTail (Struct "nil" []) = id 192 | displaysTail (Struct "cons" [h, t]) = showChar ',' . displays h . displaysTail t 193 | displaysTail x = showChar '|' . displays x 194 | 195 | instance Display Clause where 196 | displays (head :- []) = displays head . showChar '.' 197 | displays (head :- bodies) = displays head . showString " :- " . displays bodies . showChar '.' 198 | 199 | instance Display a => Display [a] where 200 | displays [] = id 201 | displays [x] = displays x 202 | displays (x:xs) = displays x . showChar ',' . displays xs 203 | 204 | instance (Display a, Display b) => Display (a, b) where 205 | displays (x, y) = displays x . showChar '=' . displays y 206 | 207 | displayLines [] = "" 208 | displayLines (x:xs) = display x ++ "\n" ++ display xs 209 | 210 | -- display (s"cons" [w"1", (s"cons" [w"2", nil])]) 211 | -- display ((s"child" [w"X",w"Y"]) :- [s"mother" [w"Y",w"X"]]) 212 | 213 | ---- REPL -- 214 | 215 | main = interact start 216 | start = writeStr ("food(apple). -- Add a clause.\n" ++ 217 | "?- food(X). -- Query.\n" ++ 218 | "?? -- Show all.\n\n") (loop []) 219 | 220 | loop :: Rules -> String -> String 221 | loop rules = readLine (exec rules . parse command "") 222 | 223 | exec :: Rules -> Either ParseError Command -> String -> String 224 | exec rules (Right (Fact c)) = writeStr ("=> " ++ display c ++ "\n" ) (loop (rules ++ [c])) 225 | exec rules (Right (Query q)) = answer q (prove rules q) rules 226 | exec rules (Right ShowAll) = writeStr (showAll rules) (loop rules) 227 | exec rules (Right Noop) = loop rules 228 | exec rules (Left e) = writeStr (show e ++ "\n") (loop rules) 229 | 230 | answer :: [Term] -> [Substitution] -> Rules -> String -> String 231 | answer q [] rules = writeStr "No\n" (loop rules) 232 | answer q (c:cs) rules = writeStr ("=> " ++ result ++ "\n") (more q cs rules) 233 | where result = display (apply c q) 234 | 235 | more :: [Term] -> [Substitution] -> Rules -> String -> String 236 | more q cs rules = readLine f 237 | where f (';':_) = answer q cs rules 238 | f x = writeStr "Yes\n" (loop rules) 239 | 240 | showAll rules = [line | r <- rules, line <- "=> " ++ display r ++ "\n" ] 241 | 242 | -- Interactive library 243 | 244 | -- Its arguments are a string to be written and next process. 245 | writeStr :: String -> (String -> String) -> (String -> String) 246 | writeStr output proc input = output ++ proc input 247 | 248 | -- Its argument is a process which receives a line. 249 | readLine :: (String -> (String -> String)) -> (String -> String) 250 | readLine proc input = case (nextLine input) of 251 | ("", []) -> "" -- End of file 252 | (line, rest) -> proc line rest 253 | 254 | nextLine "" = ("","") 255 | nextLine ('\n':xs) = ("\n", xs) 256 | nextLine (x:xs) = (x:ys, zs) where (ys, zs) = nextLine xs 257 | 258 | ---- Testing ---- 259 | 260 | -- | Test function 261 | -- 262 | -- >>> solveString "p:-q. q:-r. r." "?-p." 263 | -- > [[]] 264 | -- >>> solveString' "p(X):-q(X).q(a)." "?-p(X)." 265 | -- > ["X=X_1,X_1=a"] 266 | 267 | solveString :: String -> String -> [Substitution] 268 | solveString rules q = 269 | let rules' = parse' clauses rules 270 | q' = parse' query q 271 | in prove rules' q' 272 | 273 | solveString' rules q = [display s | s <- solveString rules q] 274 | -------------------------------------------------------------------------------- /README: -------------------------------------------------------------------------------- 1 | A pure prolog interpreter 2 | 3 | * Getting started 4 | 5 | $ runhaskell Main.hs 6 | or 7 | 8 | $ hugs Prolog.hs 9 | Prolog> main 10 | 11 | * Command 12 | 13 | food(apple). -- Add a clause. 14 | ?- food(X). -- Query. 15 | ?? -- Show all. 16 | 17 | * Example 18 | 19 | runhaskell Main.hs < demo.prolog 20 | 21 | * Compile with ghc 22 | 23 | ghc --make Main.hs 24 | -------------------------------------------------------------------------------- /Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | import System.Cmd(system) 3 | 4 | -- main = defaultMain 5 | main = defaultMainWithHooks (simpleUserHooks {runTests = runzeTests}) 6 | 7 | runzeTests a b pd lb = system ( "runhaskell ./test.hs") >> return() 8 | -------------------------------------------------------------------------------- /aprolog.cabal: -------------------------------------------------------------------------------- 1 | Name: aprolog 2 | Version: 0.1 3 | Synopsis: A pure prolog interpreter 4 | Homepage: https://github.com/propella/prolog 5 | License: MIT 6 | License-file: LICENSE 7 | Author: Takashi Yamamiya 8 | Maintainer: tak@metatoys.org 9 | Category: Language 10 | Build-type: Simple 11 | Cabal-version: >=1.2 12 | Executable aprolog 13 | Main-is: Main.hs 14 | Build-depends: haskell98, base, parsec 15 | -------------------------------------------------------------------------------- /demo.prolog: -------------------------------------------------------------------------------- 1 | % comment 2 | 3 | child(sazae, namihei). 4 | child(sazae, fune). 5 | child(katsuo, namihei). 6 | child(katsuo, fune). 7 | child(wakame, namihei). 8 | child(wakame, fune). 9 | child(tara, sazae). 10 | child(tara, masuo). 11 | 12 | ?- child(X, fune). 13 | ; 14 | ; 15 | ; 16 | 17 | grandChild(X, Z) :- child(X, Y), child(Y, Z). 18 | ?- grandChild(X, Y). 19 | ; 20 | ; 21 | 22 | t(1). 23 | t(2). 24 | t(3). 25 | perm(X, Y, Z) :- t(X), t(Y), t(Z). 26 | ?- perm(X, Y, X). 27 | ; 28 | ; 29 | ; 30 | ; 31 | ; 32 | ; 33 | ; 34 | ; 35 | ; 36 | 37 | append([], Ys, Ys). 38 | append([X|Xs], Ys, [X|Zs]) :- append(Xs, Ys, Zs). 39 | 40 | ?- append([a,b,c], [d,e], X). 41 | 42 | reverse([],[]). 43 | reverse([X|Xs], Zs) :- reverse(Xs, Ys), append(Ys, [X], Zs). 44 | 45 | ?-reverse([a,b,c,d,e], X). 46 | 47 | acReverse(Xs, Ys) :- acReverse(Xs, [], Ys). 48 | acReverse([X|Xs], Acc, Ys) :- acReverse(Xs, [X|Acc], Ys). 49 | acReverse([], Ys, Ys). 50 | 51 | ?-acReverse([a,b,c,d,e], X). 52 | 53 | -------------------------------------------------------------------------------- /note-ja.txt: -------------------------------------------------------------------------------- 1 | -*- outline -*- 2 | 3 | * Prolog を Haskell で書く。 4 | 5 | Prolog インタプリタを Haskell で書きました。しばらく書いただけで満足してしまっていたのですが、このまま人知れず消えて行くのも寂しいので勉強した事を書きます。まず、参考にしたソースは前回書いた hugs98/demos/prolog/ です。このソース。大変短くて良いのですが、素人目には簡潔すぎて難しいのと、書かれたのが古いのか do 記法を全く使っていないので、そこらへんを私風にアレンジしました。ソースを http://github.com/propella/prolog/tree に置いておきます。なお、言葉の使い方とか間違ってるかもしれないので気づいた人は教えてください。 6 | 7 | ** 実行 8 | 9 | 実行の仕方は Prolog.hs をダウンロードして、 10 | 11 | >|| 12 | runghc Prolog.hs 13 | ||< 14 | です。food(apple). のようにするとルールに追加で、?- apple(X). で問い合わせ、?? で全部のルールを表示します。 15 | >|| 16 | runghc Prolog.hs < demo.prolog 17 | ||< 18 | のようにするとテキストファイルに書かれた物を実行する事が出来ます。 19 | 20 | ** データ構造 21 | 22 | では早速中身をご紹介します。 23 | >|haskell| 24 | module Prolog 25 | (Term(..), Clause(..), w, s, cons, 26 | parse, parse', 27 | atom, variable, struct, list, nil, terms, arguments, term, clause, clauses, query, 28 | display, 29 | unify, unifyList, applyTerm, prove, rename, solveString) where 30 | 31 | import Text.ParserCombinators.Parsec 32 | import Data.Maybe (maybeToList) 33 | import Char (isUpper) 34 | ||< 35 | 36 | 関数を沢山エキスポートしてるのはユニットテストで使いたかったからです。ライブラリは、パーサとして Parsec を使ってます。あと、maybeToLst と isUpper をインポートしてます。 37 | 38 | >|haskell| 39 | 40 | infix 6 :- 41 | data Term = Var String Int | Struct String [Term] deriving (Show, Eq) 42 | data Clause = Term :- [Term] deriving (Show, Eq) 43 | data Command = Fact Clause | Query [Term] | ShowAll | Noop 44 | 45 | type Rules = [Clause] 46 | ||< 47 | 48 | ここで Prolog のデータを定義しています。Prolog の項は変数 Var または述語 Struct です。変数は変数名だけで良さそうな物ですが、Prolog の変数のスコープは一つのルール内だけなので、区別するために後で番号を付けます。それで Var String Int となっています。述語には apple のような単純なやつと、succ(zero) のような構造を持った奴の二通りありますが、単純なやつも引き数がゼロの構造として扱います。つまり、apple と apple() は同じ意味です。節は Clause として定義しています。Haskell はコンストラクタにも演算子が使えるので、なんとなく Prolog っぽく表現出来ます。あと Command はインタラクティブループで使います。 49 | 50 | これで Prolog のデータを Haskell のデータとして表現出来ますが、かなり煩雑です。例えば"mortal(X) :- man(X)" は Struct "mortal" [Var "X" 0] :- [(Struct "man" [Var "X" 0])] のようになってしまいます。これではテストケースを書くのが大変なので、便利関数を作っておきます。便利関数を使うと s"mortal" [w"X"] :- [s"man" [w"X"] ] になってちょっとましです。 51 | 52 | >|haskell| 53 | -- Utility constructors for debugging 54 | w :: String -> Term 55 | w s@(x:xs) | isUpper x = Var s 0 56 | | otherwise = Struct s [] 57 | 58 | s :: String -> [Term] -> Term 59 | s n xs = Struct n xs 60 | 61 | cons s cdr = (Struct "cons" [w s, cdr]) 62 | ||< 63 | 64 | ** ユニフィケーション 65 | 66 | ユニフィケーションというのは要するに超簡単な方程式を解く事です。例えば、(X, orange) = (apple, Y) という方程式があったら、それぞれ分からない部分を埋め合わせて X = apple で Y = orange という答えを求めるのがユニフィケーションです。ここではこの答えを表現するのに、[(変数, 内容)] というペアのリスト Substitution、いわゆる連想リストを使います。 67 | 68 | >|haskell| 69 | ---- Unification ---- 70 | 71 | type Substitution = [(Term, Term)] 72 | ||< 73 | 74 | 先ほどの例で答えを得るには、 75 | 76 | - 前どうし、後どうしをペアにする。[(X, apple), (orange, Y)] 77 | - 変数が左に来るようにする。[(X, apple), (Y, orange)] 78 | 79 | とこれだけなので簡単です。では (X, Y) = (Y, banana). という方程式はどうでしょうか？継ぎ足すと、[(X, Y), (Y, banana)] というリストが出来ます。ここから X を求めるには、 80 | 81 | - 右辺が変数のときはその変数でさらに再帰的に残りを探す。 82 | - リストを継ぎ足す時にさらに変形して [(X, banana), (Y, banana)] にする。 83 | 84 | の二通りのやりかたがあると思います。変数の参照が追加より多いときには前者の方が遅いですが簡単でデバッグしやすいので前者を使います。 85 | 86 | ではさらに難しい問題 (X, Y) = (banana, X) はどうでしょうか？これを継ぎ足すと [(X, banana), (Y, X)] になり、X は求まりますが、Y を求めるには前からもう一度検索しなくてはなりません。一回のユニフィケーションで全ての変数の値が求まらない場合、再び前から検索すると無限ループになってしまうので、これは無理です。 87 | 88 | この場合、X が banana である事は分かっているので、継ぎ足す前に (Y, X) の X を banana で置き換えて、[(X, banana), (Y, banana)] とすると上手くいきます。この置き換えを apply と呼びます。まとめると、 89 | 90 | - 両辺の要素の数が同じ事を確認する。 91 | - 左側が変数になるような連想リストを作る(ちなみに、どっちも変数の時はどっちでも良いです)。 92 | - 連想リストに次の要素を継ぎ足す時は、変数を今まで分かっている値と置き換えてから継ぎ足す。 93 | 94 | プログラムで書くとこんな感じです。ユニフィケーションできない場合は Nothing を返します。 95 | 96 | >|haskell| 97 | true = [] 98 | 99 | -- apply [(w"X", w"Y"), (w"Y", w"Z")] [(w"X"), (w"Y")] == [(w"Z"), (w"Z")] 100 | apply :: Substitution -> [Term] -> [Term] 101 | apply s ts = [applyTerm s t | t <- ts] 102 | 103 | applyTerm [] (Var y n) = Var y n 104 | applyTerm ((Var x i, t):s) (Var y j) | x == y && i == j = applyTerm s t 105 | | otherwise = applyTerm s (Var y j) 106 | applyTerm s (Struct n ts) = Struct n (apply s ts) 107 | 108 | -- unify (w"X") (w"apple") == Just [(w"X", w"apple")] 109 | unify :: Term -> Term -> Maybe Substitution 110 | unify (Var x n) (Var y m) = Just [(Var x n, Var y m)] 111 | unify (Var x n) y = Just [(Var x n, y)] 112 | unify x (Var y m) = Just [(Var y m, x)] 113 | unify (Struct a xs) (Struct b ys) 114 | | a == b = unifyList xs ys 115 | | otherwise = Nothing 116 | 117 | unifyList :: [Term] -> [Term] -> Maybe Substitution 118 | unifyList [] [] = Just true 119 | unifyList [] _ = Nothing 120 | unifyList _ [] = Nothing 121 | unifyList (x:xs) (y:ys) = do s <- unify x y 122 | s' <- unifyList (apply s xs) (apply s ys) 123 | return (s ++ s') 124 | ||< 125 | 126 | ** 検索 127 | 128 | もしもルールが一つで質問が一つしか無い場合は、ユニフィケーションだけで十分です。例えば (X, orange) = (apple, Y) 129 | >|| 130 | r(X, orange). 131 | ?- r(apple, Y). 132 | ||< 133 | 134 | と書けます。だけど実際にはルールが沢山組合わさるのが普通で、沢山のルールを順番にユニフィケーションして行って最終的な答えを求めます。この検索順序はユニフィケーション自体とは独立した機能なので、混ぜて考えないよう注意してください。Prolog では、深さ優先探索と言って、可能性の木を端から順にからユニフィケーションして行きます。木の分岐点は二種類あって意味が全然違うので混ぜないでください。 135 | 136 | - ゴール (AND 関係) : ゴールはコンマで区切られた項の形で与えられます。ソース上では横に並びます。 137 | - 選択肢 (OR 関係) : 選択肢はあるゴールにユニフィケーション出来る頭部を持つルールです。ソース上では縦に並びます。 138 | 139 | 検索木の枝の端には二つの場合があります。一つはゴールが真であると分かった場合で、apple. のように頭部はあるけど体部のないルールに当たった時です。もう一つは選択肢が無くなった場合です。ソースコード上では、ユニフィケーションが失敗すると unify 関数は Nothing を返すので maybeToList で選択肢のリストから除外しています。 140 | 141 | >|haskell| 142 | ---- Solver ---- 143 | 144 | prove :: Rules -> [Term] -> [Substitution] 145 | prove rules goals = find rules 1 goals 146 | 147 | -- Depth first search 148 | -- find (parse' clauses "p(X):-q(X). q(a).") 1 [parse' term "p(X)"] 149 | find :: Rules -> Int -> [Term] -> [Substitution] 150 | find rules i [] = [true] 151 | find rules i goals = do let rules' = rename rules i 152 | (s, goals') <- branch rules' goals 153 | solution <- find rules (i + 1) goals' 154 | return (s ++ solution) 155 | 156 | -- Find next branches. A branch is a pair of substitution and next goals. 157 | -- branch (parse' clauses "n(z). n(s(X)):-n(X).") (parse' query "?-n(X).") 158 | branch :: Rules -> [Term] -> [(Substitution, [Term])] 159 | branch rules (goal:goals) = do head :- body <- rules 160 | s <- maybeToList (unify goal head) 161 | return (s, apply s (body ++ goals)) 162 | ||< 163 | 164 | 最後に重要なのが、find 関数で検索を始める前にデータベースに含まれる変数のインデックスを一括して書き換える事です。これで、別のルールに含まれる変数が違う事を保証します。apply は変数を値で置き換えますが、rename は変数のインデックスだけを書き換えます。データベースを全部書き換えるなんて富豪的ですが、実際には Hakell の素晴らしい遅延評価によって必要な分だけ書き換える事になります(多分)。 165 | 166 | >|haskell| 167 | -- Rename all variables in the rules to split namespaces. 168 | rename :: Rules -> Int -> Rules 169 | rename rules i = [ renameVar head :- renameVars body | head :- body <- rules] 170 | where renameVar (Var s _) = Var s i 171 | renameVar (Struct s ts) = Struct s (renameVars ts) 172 | renameVars ts = [renameVar t | t <- ts] 173 | ||< 174 | 175 | 面白い部分はこれくらいです。あと、Parsec による文法や、型クラスを使った文字列表示や、継続渡しによるインタラクティブシェルの実装など、面白い話題は色々ありますがこの辺にしときます。 176 | 177 | * Haskell の Cabal を使う。 178 | 179 | いけがみさんの Haskell Advent 2010 Day 3 を読んで、そう言えば昔書いたHaskell の Prolog を放置したままだと思い出しました。折角なので試しに Cabalというのをやってみよう。ちなみに私は Haskell Platform 2010.2.0.0 を使っています。 180 | 181 | まずソースコードの構成ですが、こんな感じです。 182 | 183 | - Prolog.hs : Prolog に必要な色々な関数が入っている。 184 | - Main.hs : main 関数が入っている。ここから実行。 185 | - test.hs : 単体テストが入っている。 186 | 187 | まず、念のためちゃんと動くかどうか確認します。普段はコンパイルせずに runhaskell や ghci を使ってるのですが、コンパイルするとしたらこんな感じ。 188 | 189 | >|| 190 | $ ghc --make Main.hs 191 | ||< 192 | 193 | 実は、今までちゃんとコンパイルした事が無くて、この --make というオプションを探すのにえらい苦労しました。次に、いけがみさんの記事にあるように cabal init というコマンドで cabal ファイルを作ります。記事には、「ある程度時間をとられることを覚悟してください。」と書いてあったので変な事聞かれたらどうしよう！と思っていたのですが、質問は至って簡単です。名前とカテゴリに悩むくらいです。 194 | 195 | >|| 196 | $ cabal init 197 | ... 沢山の質問に答える。 198 | ||< 199 | 200 | これで Setup.hs と cabal ファイルの二つが出来ます。cabal ファイルには沢山コメントが付きます。コメントを抜いたらこんな感じになりました。 201 | 202 | >|| 203 | Name: aprolog 204 | Version: 0.1 205 | Synopsis: A pure prolog interpreter 206 | Homepage: https://github.com/propella/prolog 207 | License: MIT 208 | License-file: LICENSE 209 | Author: Takashi Yamamiya 210 | Maintainer: tak@metatoys.org 211 | Category: Language 212 | Build-type: Simple 213 | Cabal-version: >=1.2 214 | Executable aprolog 215 | ||< 216 | 217 | では早速ためして見ましょう。パッケージをビルドするには、Setup.hs スクリプトにオプションを付けて実行します。 218 | 219 | >|| 220 | $ runhaskell Setup configure --ghc 221 | Configuring aprolog-0.1... 222 | Error: No 'Main-Is' field found for executable aprolog 223 | ||< 224 | 225 | あれま、エラーが出ます。エラーメッセージを頼りに色々追加して行くと次のようになりました。 226 | 227 | >|| 228 | Name: aprolog 229 | Version: 0.1 230 | Synopsis: A pure prolog interpreter 231 | Homepage: https://github.com/propella/prolog 232 | License: MIT 233 | License-file: LICENSE 234 | Author: Takashi Yamamiya 235 | Maintainer: tak@metatoys.org 236 | Category: Language 237 | Build-type: Simple 238 | Cabal-version: >=1.2 239 | Executable aprolog 240 | Main-is: Main.hs 241 | Build-depends: haskell98, base, parsec 242 | ||< 243 | 244 | 多分 Build-depends の所はもっと丁寧に書いた方が良いと思います。再度ビルドしてみます。 245 | 246 | >|| 247 | $ runhaskell Setup configure --ghc 248 | Configuring aprolog-0.1... 249 | $ runhaskell Setup build 250 | Preprocessing executables for aprolog-0.1... 251 | Building aprolog-0.1... 252 | [1 of 2] Compiling Prolog ( Prolog.hs, dist/build/aprolog/aprolog-tmp/Prolo 253 | g.o ) 254 | [2 of 2] Compiling Main ( Main.hs, dist/build/aprolog/aprolog-tmp/Main.o 255 | ) 256 | Linking dist/build/aprolog/aprolog ... 257 | $ ./dist/build/aprolog/aprolog 258 | ... 259 | ||< 260 | 261 | おお、素晴らしい。次に、折角単体テストがあるので、これも Setup から呼び出せるようにしてみます。基本 Setup.hs を編集して、main = defaultMain の代わりにフック付きの defaultMainWithHooks を使って sysytem 関数で単体テストを呼び出すだけです。 262 | 263 | >|haskell| 264 | import Distribution.Simple 265 | import System.Cmd(system) 266 | 267 | main = defaultMainWithHooks (simpleUserHooks {runTests = runzeTests}) 268 | runzeTests a b pd lb = system ( "runhaskell ./test.hs") >> return() 269 | ||< 270 | 271 | 細かい引数の意味は私も良くわかってなくてコピペしただけですが、次のようにして試す事が出来ます。 272 | 273 | >|| 274 | $ runhaskell Setup test 275 | Cases: 37 Tried: 37 Errors: 0 Failures: 0 276 | Counts {cases = 37, tried = 37, errors = 0, failures = 0} 277 | ||< 278 | 279 | パッケージ化すると、なんか立派な物を作った気分になれますね。作ったものは https://github.com/propella/prolog にあります。 280 | 281 | ** 参考 282 | 283 | - Haskell Advent 2010 Day 3 http://madscientist.jp/~ikegami/diary/20101208.html 284 | - How to write a Haskell program http://www.haskell.org/haskellwiki/How_to_write_a_Haskell_program 285 | - Organising unit tests in Haskell http://blogs.linux.ie/balor/2009/07/05/organising-unit-tests-in-haskell/ 286 | -------------------------------------------------------------------------------- /note.html: -------------------------------------------------------------------------------- 1 |

Prolog In Haskell

2 | 3 |

I have been obsessed by Prolog language recent weeks. While I first 4 | learned Prolog long time ago, and actually I was attracted, I have 5 | never used it fluently because it's too hard to get familiar without 6 | any practical necessity. Although, there are a lot of interesting 7 | literatures which require certain knowledge of logic programming in 8 | computer science. So, I decided to do another approach; writing a 9 | Prolog interpreter to learn Prolog.

10 | 11 |

I chose Haskell as the implementation language because of its 12 | succinctness. I'm a beginner Haskell programmer, and I thought it was 13 | also a good opportunity to learn Prolog and Haskell same time! The 14 | starting point was a Prolog implementation in Hug98 distribution 15 | http://darcs.haskell.org/hugs98/demos/prolog/. I 16 | think this is a great Haskell program, but its too difficult to 17 | me. Rewriting it as my level would be a good exercise. 18 |

19 | 20 |

Data structures

21 | 22 |

Here is my version of Prolog in Haskell. Entire program is about 23 | 200+ lines. There is no cut operator but it has a list notation so 24 | that you can write [apple, orange | banana] stile literal. Let's take 25 | a look at the first part. 26 |

27 | 28 | 
 29 | module Prolog
 30 |     (Term(..), Clause(..), w, s, cons,
 31 |      parse, parse',
 32 |      atom, variable, struct, list, nil, terms, arguments, term, clause, clauses, query,
 33 |      display,
 34 |      unify, unifyList, applyTerm, prove, rename, solveString) where
 35 | 
 36 | import Text.ParserCombinators.Parsec
 37 | import Data.Maybe
 38 | import Char
 39 |
40 | 41 |

I used Parsec as a parser, and defined some data structures.

42 | 43 | 
 44 | infix 6 :-
 45 | data Term    = Var String Int | Struct String [Term] deriving (Show, Eq)
 46 | data Clause  = Term :- [Term]                        deriving (Show, Eq)
 47 | data Command = Fact Clause | Query [Term] | ShowAll | Noop
 48 | 
 49 | type Rules = [Clause]
 50 | type Substitution = [(Term, Term)]
 51 |
52 | 53 | 54 |

Term represents Prolog's term like "apple" or "father(abe, 55 | homer)". It can be a variable, or a structure. A variable has an index 56 | number which I used it later to distinct a same variable name in 57 | different contexts. A simple term like "apple" is also represented as 58 | a structure without elements like Struct "apple" []. 59 |

60 | 61 |

Clause is a Prolog rule like "mortal(X) :- man(X)". I stole a user 62 | defined operator constructor ":-" from original Hugs' Prolog to write 63 | a Haskell expression in Prolog like. So "mortal(X) :- man(X)" in 64 | Haskell expression becomes Struct "mortal" [Var "X" 0] :- 65 | [(Struct "man" [Var "X" 0])]. Well, it's not quite 66 | nice. Although the parser will provide better notation later, I have 67 | to use this expression when debugging the interpreter meanwhile. Its 68 | cumbersome. So I made up tiny utility functions to make Prolog data 69 | easier. 70 |

71 | 72 | 
 73 | -- Utility constructors for debugging
 74 | w :: String -> Term
 75 | w s@(x:xs) | isUpper x = Var s 0
 76 |            | otherwise = Struct s []
 77 | 
 78 | s :: String -> [Term] -> Term
 79 | s n xs = Struct n xs
 80 | 
 81 | cons s cdr = (Struct "cons" [w s, cdr])
 82 |
83 | 84 | Using this functions, now "mortal(X) :- man(X)" is written as 85 | s"mortal" [w"X"] :- [s"man" [w"X"]] . It is much better, isn't 86 | it? 87 | 88 |

Unification

89 | 90 |

By the way, I like the word unification. It sounds peace and 91 | spiritual! Unification is one of two most peculiar concept in Prolog 92 | (another one is the control structure by depth first 93 | search). Unification is solving a logical equation. For example, the 94 | answer of "[X, orange] = [apple, Y]" must be X = apple, and Y = 95 | orange. It is almost same as variable binding in a normal programming 96 | language, but tricky part is that a direction is symmetry, so X = Y 97 | and Y = X is same meaning. How can it be possibly implemented?? Think 98 | about the data structure of the answer at first. 99 |

100 | 101 | 
102 | ---- Unification ----
103 | 
104 | type Substitution = [(Term, Term)]
105 | true = []
106 |
107 | 108 |

I used a list of tuples of terms, or an associate list to 109 | represent a substitution. For example, "X = apple, Y = orange" is 110 | represented as [(X, apple), (Y, orange)] (in actual Haskell 111 | code, [(w"X", w"apple"), (w"Y", w"orange")] ). A tuple 112 | of left hand side is always a variable name, and right hand side is 113 | any term, concrete value preferably. The goal of unification is making 114 | associations with variable and term. To make this process easier, 115 | "transitive" substitution is allowed. Think about an equation "X = Y, 116 | Y = banana". It is represented like [(X, Y), (Y, banana)], which is 117 | solved as X = banana, and Y = banana in apply function. Let's look at 118 | the implementation. 119 | 120 | 

121 | -- apply [(w"X", w"Y"), (w"Y", w"Z")] [(w"X"), (w"Y")] == [(w"Z"), (w"Z")]
122 | apply :: Substitution -> [Term] -> [Term]
123 | apply s ts = [applyTerm s t | t <- ts]
124 | 
125 | applyTerm [] (Var y n)                                  = Var y n
126 | applyTerm ((Var x i, t):s) (Var y j) | x == y && i == j = applyTerm s t
127 |                                      | otherwise        = applyTerm s (Var y j)
128 | applyTerm s (Struct n ts)                               = Struct n (apply s ts)
129 |
130 | 131 |

The function apply substitutes a variable name of its value. To 132 | support transitive apply, applyTerm is called recursively if the value 133 | is also a variable. But it can solve only one way. Think about opposite 134 | case "Y = banana, X = Y". Apply can't find the fact X = banana because 135 | "Y = banana" is appeared before. So what I should do is applying X = Y 136 | before adding the substitution. 137 |

138 | 139 | 140 | 141 | 142 | 143 | 144 | 145 |
EquationSubstitution(solution)
1Y = banana, X = Y
2X = YY = banana (append)
3X = banana (apply: Y = banana) Y = banana
4Y = banana, X = banana (append)
146 | 147 |

I suppose that this two fold way solve all of logical 148 | equation. Apply is always needed before append it to the 149 | solution. Actual source implementation seems to be complicated because 150 | there are cases where a variable can appears any side, and sometimes 151 | there is no solution. To represent no-answer case, a Maybe monad is 152 | used. So there are variations such as; 153 |

154 | 155 | 160 | 161 | 
162 | -- unify (w"X") (w"apple") == Just [(w"X", w"apple")]
163 | unify :: Term -> Term -> Maybe Substitution
164 | unify (Var x n) (Var y m) = Just [(Var x n, Var y m)]
165 | unify (Var x n)      y    = Just [(Var x n,       y)]
166 | unify      x    (Var y m) = Just [(Var y m,       x)]
167 | unify (Struct a xs) (Struct b ys)
168 |       | a == b = unifyList xs ys
169 |       | otherwise   = Nothing
170 | 
171 | unifyList :: [Term] -> [Term] -> Maybe Substitution
172 | unifyList [] [] = Just true
173 | unifyList [] _ = Nothing
174 | unifyList _ [] = Nothing
175 | unifyList (x:xs) (y:ys) = do s <- unify x y
176 |                              s' <- unifyList (apply s xs) (apply s ys)
177 |                              return (s ++ s')
178 |
179 | 180 |

Note that I just use append (++) to add a new substation in 181 | unifyList. But if you design carefully, recursive apply is not 182 | necessary. Using something like a map is a better idea. 183 |

184 | 185 |

Solver

186 | 187 |

As a programming language, Prolog is unique as it has no explicit 188 | control structure. Instead, a Prolog program can be seen as a big 189 | nested if then else statement. This find and branch functions are 190 | implemented of this behavior. While unification is a technique of how 191 | to solve a equation, solver deals with when each equation should be 192 | solved. There are two most important concepts to understand control 193 | structures in Prolog. 194 |

195 | 196 | 200 | 201 |

A proof's fate is decided by branch function, branch function 202 | returns a list of goals (with corresponding substitutions). If the 203 | list is empty, this branch is failed. If the list includes empty goal, 204 | it is actually succeed because empty goal means that it is unified 205 | against a fact like "food(apple).". Well, is it complicated? 206 |

207 | 208 | 212 | 213 | The goal of find function is traverse all of goals to find whether if 214 | it is true or false. 215 | 216 | 
217 | ---- Solver ----
218 | 
219 | prove :: Rules -> [Term] -> [Substitution]
220 | prove rules goals = find rules 1 goals
221 | 
222 | -- Depth first search
223 | -- find (parse' clauses "p(X):-q(X). q(a).") 1 [parse' term "p(X)"]
224 | find :: Rules -> Int -> [Term] -> [Substitution]
225 | find rules i [] = [true]
226 | find rules i goals = do let rules' = rename rules i
227 |                         (s, goals') <- branch rules' goals
228 |                         solution <- find rules (i + 1) goals'
229 |                         return (s ++ solution)
230 | 
231 | -- Find next branches. A branch is a pair of substitution and next goals.
232 | -- branch (parse' clauses "n(z). n(s(X)):-n(X).") (parse' query "?-n(X).")
233 | branch :: Rules -> [Term] -> [(Substitution, [Term])]
234 | branch rules (goal:goals) = do head :- body <- rules
235 |                                s <- maybeToList (unify goal head)
236 |                                return (s, apply s (body ++ goals))
237 |
238 | 239 |

Find function has an argument for index number to show the depth 240 | of the tree. This number is used to rename all variables used in whole 241 | rules. This is necessary because same variable name in different 242 | clauses are actually represented different variables.

243 | 244 | 
245 | -- Rename all variables in the rules to split namespaces.
246 | rename :: Rules -> Int -> Rules
247 | rename rules i = [ renameVar head :- renameVars body | head :- body <- rules]
248 |     where renameVar (Var s _)     = Var s i
249 |           renameVar (Struct s ts) = Struct s (renameVars ts)
250 |           renameVars ts           = [renameVar t | t <- ts]
251 |
252 | 253 | I have only explained evaluator part of the REPL, but still there are 254 | reader, printer, and loop. You can browse and download whole source 255 | code 256 | from http://github.com/propella/prolog/tree. 257 | Someday I might write some of interesting topics in the program... 258 | -------------------------------------------------------------------------------- /test.hs: -------------------------------------------------------------------------------- 1 | import Test.HUnit 2 | import Prolog 3 | 4 | main = runTestTT allTest 5 | 6 | testParser p input = case (parse p "" input) of 7 | Left err -> Left (show err) 8 | Right x -> Right x 9 | 10 | allTest = test [ 11 | "list" ~: listTest, 12 | "solver" ~: solverTest, 13 | "parser" ~: parserTest, 14 | "printer" ~: printerTest, 15 | "unification" ~: unificationTest 16 | ] 17 | 18 | -- Tests 19 | 20 | solvedValue rules q i v = applyTerm (solveString rules q !! i) v 21 | 22 | listTest = test [ 23 | "[]" ~: parse' list "[]" ~=? nil, 24 | "[1]" ~: parse' list "[ 1 ] " ~=? (cons "1" nil), 25 | "[1,2]" ~: parse' list "[ 1 , 2 ] " ~=? (cons "1" (cons "2" nil)), 26 | "[1|[2]]" ~: parse' list "[ 1 | [ 2 ] ] " ~=? (cons "1" (cons "2" nil)), 27 | "[1,2|3]" ~: parse' list "[ 1 , 2 | 3 ] " ~=? (cons "1" (cons "2" (w"3"))), 28 | "[1,2|[3,4]]" ~: parse' list "[ 1 , 2 | [ 3 , 4 ] ] " ~=? 29 | (cons "1" (cons "2" (cons "3" (cons "4" nil)))) 30 | ] 31 | 32 | solverTest = test [ 33 | "fact1" ~: prove [w"apple" :- [], w"orange" :- []] [w"banana"] ~=? [], 34 | "fact2" ~: prove [w"apple" :- [], w"orange" :- []] [w"apple"] ~=? [[]], 35 | "transitive" ~: solveString "p:-q. q:-r. r." "?-p." ~=? [[]], 36 | "variable" ~: solveString "p(a)." "?-p(X)." ~=? [[(w"X", w"a")]], 37 | "rename" ~: rename (parse' clauses "p(X):-q(X).") 1 ~=? 38 | [s"p" [Var "X" 1] :- [s"q" [Var "X" 1]]], 39 | "variable" ~: solvedValue "p(X):-q(X).q(a)." "?-p(X)." 0 (w"X") 40 | ~=? (w"a"), 41 | "number" ~: solvedValue "n(z). n(s(X)):-n(X)." "?-n(X)." 5 (w"X") 42 | ~=? (parse' term "s(s(s(s(s(z))))).") 43 | ] 44 | 45 | unificationTest = test [ 46 | "apply1" ~: applyTerm [(w"X", w"Y"), (w"Y", w"Z")] (w"X") ~=? (w"Z"), 47 | "apply2" ~: applyTerm [(w"X",Var "X" 1)] (Var "X" 1) ~=? (Var "X" 1), 48 | "list" ~: unifyList [w"X",w"Y",w"Y"] [w"Z",w"Z",w"a"] ~=? 49 | Just [(w"X",w"Z"), (w"Y",w"Z"), (w"Z",w"a")] 50 | ] 51 | parserTest = test [ 52 | "atom" ~: testParser atom "atom1234" ~=? Right "atom1234", 53 | "variable" ~: testParser variable "Var1234" ~=? Right (w"Var1234"), 54 | 55 | "struct1" ~: testParser struct "father(masuo, tara)" ~=? 56 | Right (s"father" [w"masuo", w"tara"]), 57 | "struct2" ~: testParser struct "father" ~=? 58 | Right (w"father"), 59 | "struct3" ~: testParser struct "father ( masuo , tara )" ~=? 60 | Right (s"father" [w"masuo", w"tara"]), 61 | 62 | "terms1" ~: testParser terms "orange, Apple, Banana" ~=? 63 | Right [w"orange", w"Apple", w"Banana"], 64 | "terms2" ~: testParser terms "orange , Apple , Banana " ~=? 65 | Right [w"orange", w"Apple", w"Banana"], 66 | 67 | "arguments1" ~: (testParser arguments "( orange , Apple , Banana )") ~=? 68 | Right [w"orange", w"Apple", w"Banana"], 69 | "arguments2" ~: (testParser arguments " ") ~=? 70 | Right [], 71 | 72 | "term1" ~: (testParser term "orange ") ~=? Right (w"orange"), 73 | "term2" ~: (testParser term "Orange ") ~=? Right (w"Orange"), 74 | 75 | "clause1" ~: (testParser clause "head :- body .") ~=? 76 | Right (w"head" :- [w"body"]), 77 | "clause2" ~: (testParser clause "head .") ~=? 78 | Right (w"head" :- []), 79 | "clause3" ~: (testParser clause "child(X, Y) :- mother(Y, X).") ~=? 80 | Right (s"child" [w"X",w"Y"] :- [s"mother" [w"Y",w"X"]]), 81 | 82 | "query1" ~: (testParser query "?- apple .") ~=? Right [w"apple"], 83 | "query2" ~: (testParser query "?- apple , orange .") ~=? Right [w"apple", w"orange"] 84 | 85 | ] 86 | 87 | printerTest = test [ 88 | "display1" ~: display (w"Hello") ~=? "Hello", 89 | "display2" ~: display (w"hello") ~=? "hello", 90 | "display3" ~: display (s"mother" [w"sazae", w"tara"]) ~=? 91 | "mother(sazae,tara)", 92 | "display4" ~: display (w"head" :- []) ~=? "head.", 93 | "display5" ~: display (s"child" [w"X",w"Y"] :- [s"mother" [w"Y",w"X"]]) ~=? 94 | "child(X,Y) :- mother(Y,X)." 95 | 96 | ] 97 | --------------------------------------------------------------------------------