Skip to content
Browse files

pCons added

  • Loading branch information...
1 parent dcb2583 commit b3960860feed9df902205d6fd913068371c97538 @doaitse doaitse committed
View
1 src/.#Main.hs
View
1 src/Language/Prolog/NanoProlog/.#NanoProlog.hs
View
2 src/Language/Prolog/NanoProlog/Interpreter.hs
@@ -30,7 +30,7 @@ loop :: [Rule] -> IO ()
loop rules = do putStrLn "goal? "
s <- getLine
unless (s == "quit") $
- do let (goal, errors) = startParse pFun s
+ do let (goal, errors) = startParse pTerm s
if null errors
then printSolutions (solve rules emptyEnv [("0",goal)])
else do putStrLn "Some goals were expected:"
View
7 src/Language/Prolog/NanoProlog/NanoProlog.hs
@@ -19,6 +19,7 @@ module Language.Prolog.NanoProlog.NanoProlog (
, pFun
, pRule
, pTerm
+ , pCons
, pTerms
, solve
, startParse
@@ -163,8 +164,10 @@ startParse p inp = parse ((,) <$> p <*> pEnd)
pSepDot :: Parser String -> Parser [String]
pSepDot p = (:) <$> p <*> pList ((:) <$> pDot <*> p)
-pTerm, pFactor, pVar, pFun :: Parser Term
-pTerm = pChainr ((\ f a -> Fun "->" [f, a]) <$ pToken "->") pFactor
+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
pFactor = pVar
<|> pFun
<|> pParens pTerm
View
25 src/Language/Prolog/NanoProlog/Search.hs
@@ -0,0 +1,25 @@
+module Search where
+
+data Tree a = Node a [Tree a]
+ | Success
+ deriving Show
+
+bf_label t l = let (res, levels) = traverse t (l:levels)
+ traverse (Node a cs) ((l:ll):ls) = (Node l rcs, ll:rls)
+ where (rcs, rls) = traversel cs ls
+ traversel [] rls = ([], rls)
+ traversel (t:ts) ls = let (tr, ls') = traverse t ls
+ (trs,ls'') = traversel ts ls'
+ in (tr:trs, ls'')
+ in res
+
+bf_enum t = let (l:ls) = traverse t ls
+ traverse (Node a cs) ~(l:ls) = (a:l):rls
+ where rls = traversel cs ls
+ traversel [] ls = ls
+ traversel (t:ts) ls = traverse t (traversel ts ls)
+ in l
+
+t = Node 1 [Node 2 [Node 3 [], Node 4 []], Node 5 []]
+
+

0 comments on commit b396086

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