implement parse_ and make ParseFailed have only one argument

src/runtime/haskell/PGF.hs

@@ -66,6 +66,7 @@ module PGF(
 
            -- ** Parsing
            parse, parseAllLang, parseAll, complete,
+           ParseOutput(..), parse_,
 
            -- ** Evaluation
            {- PGF.compute, paraphrase,-}
@@ -125,7 +126,7 @@ module PGF(
           ) where
 
 import Prelude hiding ((<>))
-import PGF2 (PGF, GraphvizOptions(..), FId, Expr(..), Type(..), Hypo, BindType(..))
+import PGF2 (PGF, GraphvizOptions(..), FId, Expr(..), Type(..), Hypo, BindType(..), ParseOutput(..))
 import qualified PGF2
 import qualified Data.Map as Map
 import Control.Monad
@@ -227,8 +228,8 @@ parse :: PGF -> Language -> Type -> String -> [Tree]
 parse gr (CId lang) cat sent = 
   case Map.lookup lang (PGF2.languages gr) of
     Just cnc -> case PGF2.parse cnc cat sent of
-                  PGF2.ParseOk ts -> map fst ts
+                  ParseOk ts -> map fst ts
-                  _               -> []
+                  _          -> []
     Nothing  -> error ("Unknown language: " ++ lang)
 
 -- | The same as 'parseAllLang' but does not return
@@ -236,7 +237,7 @@ parse gr (CId lang) cat sent =
 parseAll     :: PGF -> Type -> String -> [[Tree]]
 parseAll gr cat sent = 
   [map fst ts | (lang,cnc) <- Map.toList (PGF2.languages gr)
-              , PGF2.ParseOk ts <- [PGF2.parse cnc cat sent]]
+              , ParseOk ts <- [PGF2.parse cnc cat sent]]
 
 -- | Tries to parse the given string with all available languages.
 -- The returned list contains pairs of language
@@ -248,17 +249,26 @@ parseAllLang :: PGF -> Type -> String -> [(Language,[Tree])]
 parseAllLang gr cat sent = 
   [(CId lang,map fst ts)
               | (lang,cnc) <- Map.toList (PGF2.languages gr)
-              , PGF2.ParseOk ts <- [PGF2.parse cnc cat sent]]
+              , ParseOk ts <- [PGF2.parse cnc cat sent]]
+
+-- | The same as 'parse' but returns more detailed information
+parse_ :: PGF -> Language -> Type -> Maybe Int -> String -> (ParseOutput [Expr],BracketedString)
+parse_ gr (CId lang) cat dp sent =
+  case Map.lookup lang (PGF2.languages gr) of
+    Just cnc -> case (PGF2.parse cnc cat sent,dp) of
+                  (ParseOk ts, Just n) -> (ParseOk (map fst (take n ts)),noBS)
+                  --(res,              ) -> res
+    Nothing  -> error ("Unknown language: " ++ lang)
 
 complete :: PGF -> Language -> Type -> String -> String -> (BracketedString,String,Map.Map Token [CId])
 complete pgf (CId lang) typ input prefix =
   case Map.lookup lang (PGF2.languages pgf) of
     Just cnc -> case PGF2.complete cnc typ input prefix of
-                  PGF2.ParseOk res -> (noBS, input++" "++prefix, Map.fromListWith (++) [(w,[CId fun]) | (w,fun,cat,_) <- res])
+                  ParseOk res -> (noBS, input++" "++prefix, Map.fromListWith (++) [(w,[CId fun]) | (w,fun,cat,_) <- res])
-                  _                -> (noBS, input++" "++prefix, Map.empty)
+                  _           -> (noBS, input++" "++prefix, Map.empty)
     Nothing  -> error ("Unknown language: " ++ lang)
-  where
+
-    noBS = error "TODO: The bracketed string is not computed"
+noBS = error "TODO: The bracketed string is not computed"
 
 linearize :: PGF -> Language -> Tree -> String
 linearize pgf (CId lang) t =

src/runtime/haskell/PGF2.hsc

@@ -840,7 +840,7 @@ fullFormLexicon c = unsafePerformIO $ do
 
 -- | This data type encodes the different outcomes which you could get from the parser.
 data ParseOutput a
-  = ParseFailed Int String         -- ^ The integer is the position in number of unicode characters where the parser failed.
+  = ParseFailed Int                -- ^ The integer is the position in number of unicode characters where the parser failed.
                                    -- The string is the token where the parser have failed.
   | ParseOk a                      -- ^ If the parsing and the type checking are successful
                                    -- we get the abstract syntax trees as either a list or a chart.
@@ -861,9 +861,9 @@ parse c ty sent =
          return (ParseOk exprs)
       (#const PGF_EXN_PARSE_ERROR) -> do
          pos <- (#peek PgfExn, code) c_exn
-         case takeWhile (not.isSpace) (drop pos sent) of
+         if pos == length sent
-           []  -> return (ParseIncomplete)
+           then return (ParseIncomplete)
-           tok -> return (ParseFailed pos tok)
+           else return (ParseFailed pos)
       (#const PGF_EXN_PGF_ERROR) -> do
          c_msg <- (#peek PgfExn, msg) c_exn
          msg <- peekCString c_msg

src/runtime/haskell/tests/parsing.hs

@@ -27,5 +27,5 @@ assertParseOk gr cnc name expr_strs str =
 
 assertParseFail gr cnc name str =
   case parse cnc (startCat gr) str of
-    ParseOk es      -> assertFailure (name++": the string should not have been parsable")
+    ParseOk es    -> assertFailure (name++": the string should not have been parsable")
-    ParseFailed _ _ -> return ()
+    ParseFailed _ -> return ()

src/runtime/python/pypgf.c

@@ -229,28 +229,14 @@ Concr_parse(ConcrObject* self, PyObject *args, PyObject *keywds)
     Py_DECREF(type);
     if (err.type == PGF_EXN_PARSE_ERROR) {
         PyObject* py_offset = PyLong_FromLong(err.code);
+        PyObject_SetAttrString(ParseError, "offset", py_offset);
+        Py_DECREF(py_offset);
 
         Py_ssize_t len = PyUnicode_GET_LENGTH(sentence);
-
-        PyObject_SetAttrString(ParseError, "offset", py_offset);
         if (err.code == len)
             PyObject_SetAttrString(ParseError, "incomplete",  Py_True);
-        else {
+        else
-            Py_ssize_t end = PyUnicode_FindChar(sentence, ' ', err.code, -1, 1);
-            if (end == -1)
-                end = len;
-            else if (end == -2)
-                return NULL;
-            PyObject *py_token = PyUnicode_Substring(sentence, err.code, end);
-            if (py_token == NULL)
-                return NULL;
-
             PyObject_SetAttrString(ParseError, "incomplete",  Py_False);
-            PyObject_SetAttrString(ParseError, "token", py_token);
-
-            Py_DECREF(py_token);
-            Py_DECREF(py_offset);
-        }
 
         PyErr_Format(ParseError, "Parse error at position %d", err.code);
         return NULL;