Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

Preparing 0.2.1

  • Loading branch information...
commit 3e9ee1ad77de4735498d24158afc5f8bf6a40f23 1 parent 76b5a0c
@norm2782 norm2782 authored
View
2  NanoProlog.cabal
@@ -1,5 +1,5 @@
Name: NanoProlog
-Version: 0.2
+Version: 0.2.1
Synopsis: Very small interpreter for a Prolog-like language
Description: This package was developed to demonstrate the ideas behind
the Prolog language. It contains a very small interpreter
View
3  src/Language/Prolog/NanoProlog/Interpreter.hs
@@ -44,8 +44,7 @@ loop rules = do putStrLn "goal? "
printSolutions :: Result -> IO ()
printSolutions result = sequence_
[ do sequence_ [ putStrLn (prefix ++ " " ++ show (subst env pr))
- | (prefix, pr@(p :<-: pp)) <- reverse proof
--- , length pp >0
+ | (prefix, pr) <- reverse proof
]
putStr "substitution: "
putStrLn (show' env)
View
11 src/Language/Prolog/NanoProlog/NanoProlog.hs
@@ -95,7 +95,7 @@ solve :: [Rule] -> Maybe Env -> [TaggedTerm] -> Result
solve _ Nothing _ = ApplyRules []
solve _ (Just e) [] = Done e
solve rls e ((tg,t):ts) = ApplyRules
- [ let tagged = map (\n -> tg ++ "." ++ show n) [1..]
+ [ let tagged = map (\n -> tg ++ "." ++ show n) ([1..] :: [Int])
result' = solve rls nextenv (zip tagged cs ++ ts)
in (tg, rule, result')
| rule@(c :<-: cs) <- tag tg rls
@@ -110,8 +110,8 @@ solve rls e ((tg,t):ts) = ApplyRules
enumerateDepthFirst :: Proofs -> Result -> [(Proofs, Env)]
enumerateDepthFirst proofs (Done env) = [(proofs, env)]
enumerateDepthFirst proofs (ApplyRules bs) =
- [ s | (tag, rule@(c :<-: cs), subTree) <- bs
- , s <- enumerateDepthFirst ((tag, rule):proofs) subTree
+ [ s | (tag', rule, subTree) <- bs
+ , s <- enumerateDepthFirst ((tag', rule):proofs) subTree
]
{-
@@ -149,9 +149,12 @@ startParse :: (ListLike s b, Show b) => P (Str b s LineColPos) a -> s
startParse p inp = parse ((,) <$> p <*> pEnd)
$ createStr (LineColPos 0 0 0) inp
+pSepDot :: Parser String -> Parser [String]
+pSepDot p = (:) <$> p <*> pFoldr list_alg ((:) <$> pDot <*> p)
+
pTerm, pVar, pFun :: Parser Term
pTerm = pVar <|> pFun
-pVar = Var <$> lexeme ((++) <$> pList1 pUpper <*> pList pDigit)
+pVar = Var <$> lexeme ((++) <$> pList1 pUpper <*> (concat <$> pSepDot (pList1 pDigit) <|> pure []))
pFun = Fun <$> pLowerCase <*> (pParens pTerms `opt` [])
where pLowerCase :: Parser String
pLowerCase = (:) <$> pLower <*> lexeme (pList (pLetter <|> pDigit))
Please sign in to comment.
Something went wrong with that request. Please try again.