Split the library up into an executable and a library

src/Language/Prolog/NanoProlog.hs

@@ -2,26 +2,27 @@
 {-# LANGUAGE FlexibleContexts #-}
 
 module Language.Prolog.NanoProlog (
-    Term(..)
-  , Rule((:<-:))
+    Env
   , LowerCase
-  , unify
+  , Result(..)
+  , Rule((:<-:))
+  , Term(..)
+  , emptyEnv
   , subst
-  , startParse
+  , pFun
+  , pList
   , pRule
   , pTerm
-  , pFun
-  , printSolutions
-  , emptyEnv
   , solve
+  , startParse
+  , unify
   ) where
 
 import            Data.ListLike.Base (ListLike)
 import            Data.List (intercalate)
 import            Text.ParserCombinators.UU
 import            Text.ParserCombinators.UU.BasicInstances
 import            Text.ParserCombinators.UU.Utils
-import            System.IO
 
 
 -- * Types
@@ -79,31 +80,6 @@ solve rules  e  n  (t:ts)
                  | rule@(c :<-: cs)   <- tag n rules 
                  ]
 
--- ** Printing the solutions
--- | `printSolutions` performs a depth-first walk over the `Result` tree, while accumulating the rules that were applied on the path which was traversed from the root to the current node. At a successful leaf tis contains the full proof
-printSolutions :: IO () -> [String] -> Result -> IO ()
-printSolutions prProof _ (Done env)     = do prProof
-                                             putStr "solution: "
-                                             printEnv env
-                                             getLine
-                                             return ()
-printSolutions _       _ None           = return ()
-printSolutions prProof (pr:prefixes) (ApplyRules  bs) 
-    = sequence_ [ printSolutions (prProof >> putStrLn  (pr ++ " " ++ show rule))  (extraPrefixes++prefixes) result 
-                | (rule@(c :<-: cs), result) <-  bs
-                , let extraPrefixes = take (length cs) (map (\i -> pr ++ "." ++ show i) [(1 :: Int) ..])
-                ]
-
--- | `printEnv` prints a single solution, shwoing only the variables that were introduced in the original goal
-printEnv :: Env -> IO ()
-printEnv  bs =  putStr (intercalate ", " . filter (not.null) . map  showBdg $ bs)
-             where  showBdg (    x,t)  | isGlobVar x =  x ++ " <- "++ showTerm t 
-                                       | otherwise = ""   
-                    showTerm t@(Var _)  = showTerm (subst bs t) 
-                    showTerm (Fun f []) = f 
-                    showTerm (Fun f ts) = f ++"("++ (intercalate ", " (map showTerm ts)) ++ ")"
-                    isGlobVar x = head x `elem` ['A'..'Z'] && last x `notElem` ['0'..'9']   
-
 instance Show Term where
   show (Var  i)      = i
   show (Fun  i [] )  = i

src/Main.hs

@@ -0,0 +1,59 @@
+module Main where
+
+import            Language.Prolog.NanoProlog
+import            Data.List (intercalate)
+import            Text.ParserCombinators.UU
+import            System.IO
+
+-- * Running the Interpreter
+-- ** The main interpreter
+-- | The `main` program prompt for a file with Prolog rules and call the main interpreter loop
+main :: IO ()
+main = do  hSetBuffering stdin LineBuffering
+           putStr "File with rules? "
+           fn  <- getLine
+           s   <- readFile fn
+           let (rules, errors) = startParse (pList pRule)  s
+           if Prelude.null errors then  do  mapM_ print rules
+                                            loop rules
+                                  else  do  putStrLn "No rules parsed"
+                                            mapM_ print errors
+                                            main
+
+-- | `loop` ask for a goal, and enuartes all solutions found, each preceded by a trace conatining the rules applied in a tree-like fashion
+loop :: [Rule] -> IO ()
+loop rules = do  putStr "goal? "
+                 s <- getLine
+                 unless (s == "quit") $
+                   do  let (goal, errors) = startParse  pFun s
+                       if null errors
+                         then  printSolutions (print goal) ["0"] (solve rules  emptyEnv 0 [goal])
+                         else  do  putStrLn "Some goals were expected:"
+                                   mapM_ (putStrLn.show) errors
+                       loop rules
+
+
+-- ** Printing the solutions
+-- | `printSolutions` performs a depth-first walk over the `Result` tree, while accumulating the rules that were applied on the path which was traversed from the root to the current node. At a successful leaf tis contains the full proof
+printSolutions :: IO () -> [String] -> Result -> IO ()
+printSolutions prProof _ (Done env)     = do prProof
+                                             putStr "solution: "
+                                             printEnv env
+                                             getLine
+                                             return ()
+printSolutions _       _ None           = return ()
+printSolutions prProof (pr:prefixes) (ApplyRules  bs) 
+    = sequence_ [ printSolutions (prProof >> putStrLn  (pr ++ " " ++ show rule))  (extraPrefixes++prefixes) result 
+                | (rule@(c :<-: cs), result) <-  bs
+                , let extraPrefixes = take (length cs) (map (\i -> pr ++ "." ++ show i) [(1 :: Int) ..])
+                ]
+
+-- | `printEnv` prints a single solution, shwoing only the variables that were introduced in the original goal
+printEnv :: Env -> IO ()
+printEnv  bs =  putStr (intercalate ", " . filter (not.null) . map  showBdg $ bs)
+             where  showBdg (    x,t)  | isGlobVar x =  x ++ " <- "++ showTerm t 
+                                       | otherwise = ""   
+                    showTerm t@(Var _)  = showTerm (subst bs t) 
+                    showTerm (Fun f []) = f 
+                    showTerm (Fun f ts) = f ++"("++ (intercalate ", " (map showTerm ts)) ++ ")"
+                    isGlobVar x = head x `elem` ['A'..'Z'] && last x `notElem` ['0'..'9']   

src/royals.pro

@@ -0,0 +1,24 @@
+ma(mien,juul).
+ma(juul,bea).
+ma(bea,alex).
+ma(bea,cons).
+oma(X,Z):-ma(X,Y),ouder(Y,Z).
+
+append(nil,X,X).
+append(cons(A,X), Y, cons(A,Z)):- append(X,Y,Z) .
+
+pa(alex,ale).
+pa(alex,ama).
+pa(alex,ari).
+ma(max,ale).
+ma(max,ama).
+ma(max,ari).
+
+ouder(X,Y) :- pa(X,Y).
+ouder(X,Y) :- ma(X,Y).
+
+voor(X,Y) :- ouder(X,Y).
+voor(X,Y) :- ouder(X,Z), voor(Z,Y).
+
+plus(zero,X,X).
+plus(succ(X), Y, succ(Z)) :- plus(X, Y,Z).