NanoProlog 0.2.3.3 → 0.3

raw patch · 4 files changed

+89/−71 lines, 4 filesdep ~uu-parsinglibPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: uu-parsinglib

API changes (from Hackage documentation)

Files

• NanoProlog.cabal +14/−7
• src/Language/Prolog/NanoProlog/Interpreter.hs +20/−17
• src/Language/Prolog/NanoProlog/NanoProlog.hs +7/−47
• src/Language/Prolog/NanoProlog/Parser.hs +48/−0

@@ -1,5 +1,5 @@ Name:                NanoProlog-Version:             0.2.3.3+Version:             0.3 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@@ -29,16 +29,23 @@   Main-is: Main.hs    Build-depends:-    base >= 4 && < 5,-    uu-parsinglib >= 2.7.1+    base           >= 4      && < 5,+    uu-parsinglib  >= 2.7.1  && < 2.8 +  GHC-Options:      -Wall -fwarn-tabs -funbox-strict-fields+                    -fno-warn-unused-do-bind+ Library-  Build-Depends:    base >= 4.0 && < 5.0,-                    uu-parsinglib >= 2.7.1,-                    ListLike == 3.1.*,-                    containers == 0.4.*+  Build-Depends:    base           >= 4.0    && < 5.0,+                    uu-parsinglib  >= 2.7.1  && < 2.8,+                    ListLike       == 3.1.*,+                    containers     == 0.4.*   Hs-Source-Dirs:   src   Exposed-modules:  Language.Prolog.NanoProlog.NanoProlog,+                    Language.Prolog.NanoProlog.Parser,                     Language.Prolog.NanoProlog.Interpreter   Extensions:       Rank2Types, FlexibleContexts, TypeSynonymInstances,                     FlexibleInstances+  GHC-Options:      -Wall -fwarn-tabs -funbox-strict-fields+                    -fno-warn-unused-do-bind+

@@ -1,9 +1,11 @@ module Language.Prolog.NanoProlog.Interpreter where  import            Language.Prolog.NanoProlog.NanoProlog+import            Language.Prolog.NanoProlog.Parser import            Text.ParserCombinators.UU import            System.Environment import            System.IO+import            Data.List  -- * Running the Interpreter -- ** The main interpreter@@ -27,15 +29,17 @@ -- | `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  putStrLn "goal? "-                 s <- getLine-                 unless (s == "quit") $-                   do  let (goal, errors) = startParse pTerm s-                       if null errors-                         then  printSolutions (solve rules emptyEnv [("0",goal)])-                         else  do  putStrLn "Some goals were expected:"-                                   mapM_ print errors-                       loop rules+loop rules = do+  putStrLn "goal? "+  s <- getLine+  unless (s == "quit") $+    do  let (goal, errors) = startParse pTerm s+        if null errors+          then  printSolutions (solve rules emptyEnv [("0",goal)])+          else  do  putStrLn "Some goals were expected:"+                    print  goal+                    mapM_ print errors+        loop rules  -- | `printSolutions` takes the result of a treewalk, which constructs -- all the proofs, and pairs them with their final@@ -46,11 +50,10 @@ -- 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 =+  sequence_ (intersperse (putStr "next?" >> void getLine)+    [  do mapM_ (\(prefix, pr) ->  putStrLn (prefix ++ " " ++ show (subst env pr)))+                (reverse proof)+          putStr "substitution: "+          print env+    |  (proof, env) <- enumerateDepthFirst [] result ])

@@ -1,8 +1,3 @@-{-# LANGUAGE Rank2Types #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE TypeSynonymInstances #-}-{-# LANGUAGE FlexibleInstances #-}- module Language.Prolog.NanoProlog.NanoProlog (      Env(..)   ,  UpperCase@@ -18,23 +13,13 @@   ,  emptyEnv   ,  enumerateDepthFirst   ,  matches-  ,  pFun-  ,  pRule-  ,  pTerm-  ,  pCons-  ,  pTerms   ,  solve-  ,  startParse   ,  unify   ) where -import            Data.ListLike.Base (ListLike) import            Data.List (intercalate) import            Data.Map (Map) import qualified  Data.Map as M-import            Text.ParserCombinators.UU-import            Text.ParserCombinators.UU.BasicInstances-import            Text.ParserCombinators.UU.Utils  -- * Types type UpperCase  = String@@ -146,9 +131,13 @@ 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 ++ "."@@ -156,32 +145,3 @@  showCommas :: Show a => [a] -> String showCommas l = intercalate ", " (map show l)---- ** Parsing Rules and Terms-startParse :: (ListLike s b, Show b)  =>-              P (Str b s LineColPos) a -> s ->  (a, [Error LineColPos])-startParse p inp  =  parse ((,) <$> p <*> pEnd)-                  $  createStr (LineColPos 0 0 0) inp--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-pFactor  =     pVar-          <|>  pFun-          <|>  pParens pTerm--pVar   =      Var      <$>  lexeme ((++) <$> pList1 pUpper <*> (concat <$> pSepDot (pList1 pDigit) `opt` []))-pFun   =      Fun      <$>  pLowerCase <*> (pParens pTerms `opt` [])-         <|>  Fun "[]" <$>  pBrackets ((:[]) <$> pTerm)-  where  pLowerCase :: Parser String-         pLowerCase = lexeme ((:) <$> pLower <*> pList (pLetter <|> pDigit))--pRule :: Parser Rule-pRule = (:<-:) <$> pFun <*> (pSymbol ":-" *> pTerms `opt` []) <* pDot--pTerms :: Parser [Term]-pTerms = pList1Sep pComma pTerm

@@ -0,0 +1,48 @@+{-# LANGUAGE Rank2Types #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE TypeSynonymInstances #-}+{-# LANGUAGE FlexibleInstances #-}++module Language.Prolog.NanoProlog.Parser (+     pFun+  ,  pRule+  ,  pTerm+  ,  pCons+  ,  pTerms+  ,  startParse+  ) where++import            Data.ListLike.Base (ListLike)+import            Language.Prolog.NanoProlog.NanoProlog+import            Text.ParserCombinators.UU+import            Text.ParserCombinators.UU.BasicInstances+import            Text.ParserCombinators.UU.Utils++-- ** Parsing Rules and Terms+startParse :: (ListLike s b, Show b)  =>+              P (Str b s LineColPos) a -> s ->  (a, [Error LineColPos])+startParse p inp  =  parse ((,) <$> p <*> pEnd)+                  $  createStr (LineColPos 0 0 0) inp++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 = pChainr ((\ h t -> Fun "cons" [h, t]) <$ pToken ":" ) pFactor+pFactor  =     pVar+          <|>  pFun+          <|>  pParens pTerm++pVar   =      Var      <$>  lexeme ((++) <$> pList1 pUpper <*> (concat <$> pSepDot (pList1 pDigit) `opt` []))+pFun   =      Fun      <$>  pLowerCase <*> (pParens pTerms `opt` [])+         <|>  Fun "[]" <$>  pBrackets ((:[]) <$> pTerm)+  where  pLowerCase :: Parser String+         pLowerCase = lexeme ((:) <$> pLower <*> pList (pLetter <|> pDigit))++pRule :: Parser Rule+pRule = (:<-:) <$> pFun <*> (pSymbol ":-" *> pTerms `opt` []) <* pDot++pTerms :: Parser [Term]+pTerms = pList1Sep pComma pTerm+