Skip to content
Browse files

added formatting infix list conses

  • Loading branch information...
1 parent 674e905 commit de943bcbeb66d1ed9546a00cde48b52b79cc428b @doaitse doaitse committed Oct 20, 2011
Showing with 17 additions and 14 deletions.
  1. +8 −8 src/Language/Prolog/NanoProlog/Interpreter.hs
  2. +9 −6 src/Language/Prolog/NanoProlog/NanoProlog.hs
View
16 src/Language/Prolog/NanoProlog/Interpreter.hs
@@ -4,6 +4,7 @@ import Language.Prolog.NanoProlog.NanoProlog
import Text.ParserCombinators.UU
import System.Environment
import System.IO
+import Data.List
-- * Running the Interpreter
-- ** The main interpreter
@@ -34,6 +35,7 @@ loop rules = do putStrLn "goal? "
if null errors
then printSolutions (solve rules emptyEnv [("0",goal)])
else do putStrLn "Some goals were expected:"
+ print goal
mapM_ print errors
loop rules
@@ -46,11 +48,9 @@ loop rules = do putStrLn "goal? "
-- directly stemming from the data base are not printed. This makes
-- the proofs much shorter, but a bit less complete.
printSolutions :: Result -> IO ()
-printSolutions result = sequence_
- [ do sequence_ [ putStrLn (prefix ++ " " ++ show (subst env pr))
- | (prefix, pr) <- reverse proof
- ]
- putStr "substitution: "
- putStrLn (show env)
- void getLine
- | (proof, env) <- enumerateDepthFirst [] result ]
+printSolutions result = do sequence_ (intersperse (do {putStr "next?";void getLine})
+ [ do mapM_ (\(prefix, pr) -> putStrLn (prefix ++ " " ++ show (subst env pr)))
+ (reverse proof)
+ putStr "substitution: "
+ putStrLn (show env)
+ | (proof, env) <- enumerateDepthFirst [] result ])
View
15 src/Language/Prolog/NanoProlog/NanoProlog.hs
@@ -146,9 +146,13 @@ instance Show Env where
instance Show Term where
show (Var i) = i
show (Fun i [] ) = i
- show (Fun "->" [f,a]) = "(" ++ show f ++ ")" ++ " -> " ++ show a
- show (Fun "[]" [l]) = "[" ++ show l ++ "]"
- show (Fun i ts ) = i ++ "(" ++ showCommas ts ++ ")"
+ show (Fun "->" [f@(Fun "->" _) ,a]) = "(" ++ show f ++ ")" ++ " -> " ++ show a
+ show (Fun "->" [f ,a]) = show f ++ " -> " ++ show a
+ show (Fun "cons" [h@(Fun "->" _),t]) = "(" ++ show h ++ ")" ++ ":" ++ show t
+ show (Fun "cons" [h@(Fun "cons" _),t]) = "(" ++ show h ++ ")" ++ ":" ++ show t
+ show (Fun "cons" [h ,t]) = show h ++ ":" ++ show t
+ show (Fun "[]" [l]) = "[" ++ show l ++ "]"
+ show (Fun i ts ) = i ++ "(" ++ showCommas ts ++ ")"
instance Show Rule where
show (t :<-: [] ) = show t ++ "."
@@ -167,9 +171,8 @@ pSepDot :: Parser String -> Parser [String]
pSepDot p = (:) <$> p <*> pList ((:) <$> pDot <*> p)
pTerm, pFactor, pCons, pVar, pFun :: Parser Term
-pTerm = pChainr ((\ f a -> Fun "->" [f, a]) <$ pToken "->") pCons
-pCons = (\a b -> Fun "cons" [a, b]) <$> pFactor <* pToken ":" <*> pCons
- <|> pFactor
+pTerm = pChainr ((\ f a -> Fun "->" [f, a]) <$ pToken "->") pCons
+pCons = pChainr ((\ h t -> Fun "cons" [h, t]) <$ pToken ":" ) pFactor
pFactor = pVar
<|> pFun
<|> pParens pTerm

0 comments on commit de943bc

Please sign in to comment.
Something went wrong with that request. Please try again.