home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / hugs101.zip / hugs101sc.zip / hugsdist / demos / Prolog / Main < prev    next >
Text File  |  1995-02-14  |  3KB  |  83 lines
  1. --
  2. -- Prolog interpreter top level module
  3. -- Mark P. Jones November 1990, modified for Gofer 20th July 1991
  4. --
  5. -- uses Gofer version 2.28
  6. --
  7.  
  8. --- Command structure and parsing:
  9.  
  10. data Command = Fact Clause | Query [Term] | Show | Error | Quit | NoChange
  11.  
  12. command :: Parser Command
  13. command  = just (sptok "bye" `orelse` sptok "quit") `do` (\quit->Quit)
  14.                `orelse`
  15.            just (okay NoChange)
  16.                `orelse`
  17.            just (sptok "??") `do` (\show->Show)
  18.                `orelse`
  19.            just clause `do` Fact
  20.                `orelse`
  21.            just (sptok "?-" `seq` termlist) `do` (\(q,ts)->Query ts)
  22.                `orelse`
  23.            okay Error
  24.  
  25. --- Main program read-solve-print loop:
  26.  
  27. signOn           :: String
  28. signOn            = "Mini Prolog Version 1.5g (" ++ version ++ ")\n\n"
  29.  
  30. main             :: Dialogue
  31. main              = echo False abort
  32.                     (appendChan stdout signOn abort
  33.                     (appendChan stdout ("Reading " ++ stdlib) abort
  34.                     (readFile stdlib
  35.                       (\fail -> appendChan stdout "...not found\n" abort
  36.                                     (interpreter []))
  37.                       (\is   -> let parse   = map clause (lines is)
  38.                                     clauses = [ r | ((r,""):_) <- parse ]
  39.                                     reading = ['.'| c <- clauses] ++ "done\n"
  40.                                 in
  41.                                 appendChan stdout reading abort
  42.                                     (interpreter clauses))
  43.                     )))
  44.  
  45. stdlib           :: String
  46. stdlib            = "stdlib"
  47.  
  48. interpreter      :: [Clause] -> Dialogue
  49. interpreter lib   = readChan stdin abort
  50.                     (\is -> appendChan stdout (loop startDb is) abort done)
  51.                     where startDb = foldl addClause emptyDb lib
  52.  
  53. loop             :: Database -> String -> String
  54. loop db           = readln "> " (exec db . fst . head . command)
  55.  
  56. exec             :: Database -> Command -> String -> String
  57. exec db (Fact r)  = skip                              (loop (addClause db r))
  58. exec db (Query q) = demonstrate db q
  59. exec db Show      = writeln (show db)                 (loop db)
  60. exec db Error     = writeln "I don't understand\n"    (loop db)
  61. exec db Quit      = writeln "Thank you and goodbye\n" end
  62. exec db NoChange  = skip                              (loop db)
  63.  
  64. --- Handle printing of solutions etc...
  65.  
  66. solution      :: [Id] -> Subst -> [String]
  67. solution vs s  = [ show (Var i) ++ " = " ++ show v
  68.                                 | (i,v) <- [ (i,s i) | i<-vs ], v /= Var i ]
  69.  
  70. demonstrate     :: Database -> [Term] -> Interactive
  71. demonstrate db q = printOut (map (solution vs) (prove db q))
  72.  where vs               = (nub . concat . map varsIn) q
  73.        printOut []      = writeln "no.\n"     (loop db)
  74.        printOut ([]:bs) = writeln "yes.\n"    (loop db)
  75.        printOut (b:bs)  = writeln (doLines b) (nextReqd bs)
  76.        doLines          = foldr1 (\xs ys -> xs ++ "\n" ++ ys)
  77.        nextReqd bs      = writeln " "
  78.                             (readch (\c->if c==';'
  79.                                            then writeln ";\n" (printOut bs)
  80.                                            else writeln "\n"  (loop db)) "")
  81.  
  82. --- End of Main.hs
  83.