Fix for GHC module renaming
[nofib.git] / real / prolog / Main.hs
1 --
2 -- Prolog interpreter top level module
3 -- Mark P. Jones November 1990
4 --
5 -- uses Haskell B. version 0.99.3
6 --
7 module Main(main) where
8
9 import PrologData
10 import Parse
11 import Interact
12 import Subst
13 import Engine
14 import Version
15 import Data.List(nub)--1.3
16
17 import Control.Monad
18 import System.Environment
19 import System.IO.Error (catchIOError)
20 import NofibUtils
21
22 --- Command structure and parsing:
23
24 data Command = Fact Clause | Query [Term] | Show | Error | Quit | NoChange
25
26 command :: Parser Command
27 command = just (sptok "bye" `orelse` sptok "quit") `doo` (\quit->Quit)
28 `orelse`
29 just (okay NoChange)
30 `orelse`
31 just (sptok "??") `doo` (\show->Show)
32 `orelse`
33 just clause `doo` Fact
34 `orelse`
35 just (sptok "?-" `seQ` termlist) `doo` (\(q,ts)->Query ts)
36 `orelse`
37 okay Error
38
39 --- Main program read-solve-print loop:
40
41 signOn :: String
42 signOn = "Mini Prolog Version 1.5 (" ++ version ++ ")\n\n"
43
44 main = --echo False abort
45 putStr signOn >>
46 putStr ("Reading " ++ stdlib) >>
47 catchIOError (readFile stdlib)
48 (\fail -> putStr "...not found\n" >> return "")
49 >>= \ is ->
50 if null is then
51 interpreter []
52 else
53 let parse = map clause (lines is)
54 clauses = [ r | ((r,""):_) <- parse ]
55 reading = ['.'| c <- clauses] ++ "done\n"
56 in
57 putStr reading >>
58 interpreter clauses
59
60 stdlib :: String
61 stdlib = "runtime_files/stdlib"
62
63 interpreter :: [Clause] -> IO ()
64 interpreter lib = do
65 let startDb = foldl addClause emptyDb lib
66 is <- getContents
67 replicateM_ 200 $ do
68 is' <- salt is
69 print (hash (loop startDb is'))
70
71 loop :: Database -> String -> String
72 loop db = readln "> " (exec db . fst . head . command)
73
74 exec :: Database -> Command -> String -> String
75 exec db (Fact r) = skip (loop (addClause db r))
76 exec db (Query q) = demonstrate db q
77 exec db Show = writeln (show db) (loop db)
78 exec db Error = writeln "I don't understand\n" (loop db)
79 exec db Quit = writeln "Thank you and goodbye\n" end
80 exec db NoChange = skip (loop db)
81
82 --- Handle printing of solutions etc...
83
84 solution :: [Id] -> Subst -> [String]
85 solution vs s = [ show (Var i) ++ " = " ++ show v
86 | (i,v) <- [ (i,s i) | i<-vs ], v /= Var i ]
87
88 demonstrate :: Database -> [Term] -> Interactive
89 demonstrate db q = printOut (map (solution vs) (prove db q))
90 where vs = (nub . concat . map varsIn) q
91 printOut [] = writeln "no.\n" (loop db)
92 printOut ([]:bs) = writeln "yes.\n" (loop db)
93 printOut (b:bs) = writeln (doLines b) (nextReqd bs)
94 doLines = foldr1 (\xs ys -> xs ++ "\n" ++ ys)
95 nextReqd bs = writeln " "
96 (readch (\c->if c==';'
97 then writeln ";\n" (printOut bs)
98 else writeln "\n" (loop db)) "")
99
100 --- End of Main.hs