Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

Split the library up into an executable and a library

  • Loading branch information...
commit 5d3fadb0b1bc189df4542e16121b4d42c8aa8016 1 parent 33c6470
@norm2782 norm2782 authored
Showing with 92 additions and 33 deletions.
  1. +9 −33 src/Language/Prolog/NanoProlog.hs
  2. +59 −0 src/Main.hs
  3. +24 −0 src/royals.pro
View
42 src/Language/Prolog/NanoProlog.hs
@@ -2,18 +2,20 @@
{-# 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)
@@ -21,7 +23,6 @@ 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
View
59 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']
View
24 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).
Please sign in to comment.
Something went wrong with that request. Please try again.