diff --git a/src/Text/ParserCombinators/UU/BasicInstances.hs b/src/Text/ParserCombinators/UU/BasicInstances.hs --- a/src/Text/ParserCombinators/UU/BasicInstances.hs +++ b/src/Text/ParserCombinators/UU/BasicInstances.hs @@ -8,6 +8,7 @@ NoMonomorphismRestriction, TypeSynonymInstances, ScopedTypeVariables, + BangPatterns, TypeOperators #-} -- | This module contains basic instances for the class interface described in the "Text.ParserCombinators.UU.Core" module. @@ -46,6 +47,7 @@ import Data.Word -- import Debug.Trace import qualified Data.ListLike as LL +import Data.List (foldl') -- * `Error` -- |The data type `Error` describes the various kinds of errors which can be generated by the instances in this module @@ -83,7 +85,7 @@ -- | the accumulated error messages msgs :: [Error loc], -- | the current input position - pos :: loc, + pos :: !loc, -- | we want to avoid deletions after insertions deleteOk :: !Bool } @@ -101,10 +103,10 @@ -- The first parameter is the current position, and the second parameter the part which has been removed from the input. instance IsLocationUpdatedBy Int Char where - advance pos _ = pos + 1 + advance !pos _ = pos + 1 instance IsLocationUpdatedBy Int Word8 where - advance pos _ = pos + 1 + advance !pos _ = pos + 1 data LineCol = LineCol !Int !Int deriving Show instance IsLocationUpdatedBy LineCol Char where @@ -121,7 +123,7 @@ _ -> LineColPos line (pos + 1) (abs + 1) instance IsLocationUpdatedBy loc a => IsLocationUpdatedBy loc [a] where - advance = foldl advance + advance = foldl' advance instance (Show a, LL.ListLike s a) => Eof (Str a s loc) where eof (Str i _ _ _ ) = LL.null i diff --git a/src/Text/ParserCombinators/UU/Core.hs b/src/Text/ParserCombinators/UU/Core.hs --- a/src/Text/ParserCombinators/UU/Core.hs +++ b/src/Text/ParserCombinators/UU/Core.hs @@ -538,18 +538,25 @@ ) (maxBound, error "getCheapest") l -traverse :: Int -> Steps a -> Int -> Int -> Int -traverse 0 _ v c = trace' ("traverse " ++ show' 0 v c ++ " choosing" ++ show v ++ "\n") v -traverse n (Step _ l) v c = trace' ("traverse Step " ++ show' n v c ++ "\n") (traverse (n - 1 ) l (v - n) c) -traverse n (Micro x l) v c = trace' ("traverse Micro " ++ show' n v c ++ "\n") (traverse n l v c) -traverse n (Apply _ l) v c = trace' ("traverse Apply " ++ show n ++ "\n") (traverse n l v c) -traverse n (Fail m m2ls) v c = trace' ("traverse Fail " ++ show m ++ show' n v c ++ "\n") - (foldr (\ (w,l) c' -> if v + w < c' then traverse (n - 1 ) l (v+w) c' - else c') c (map ($m) m2ls) - ) -traverse n (End_h ((a, lf)) r) v c = traverse n (lf a `best` removeEnd_h r) v c -traverse n (End_f (l :_) r) v c = traverse n (l `best` r) v c -traverse n (Done _ ) v c = trace' ("traverse at Done" ++ show' 0 v c ++ " choosing" ++ show v ++ "\n") 0 +traverse :: Int -> Steps a -> Int -> Int -> Int +traverse 0 _ v c = trace' ("traverse " ++ show' 0 v c ++ " choosing " ++ show v ++ "\n") $ + v + 100 -- uncertainty cost +traverse n (Step _ l) v c = trace' ("traverse Step " ++ show' n v c ++ "\n") $ + traverse (n - 1) l v c +traverse n (Micro x l) v c = trace' ("traverse Micro " ++ show' n v c ++ "\n") $ + traverse n l v c +traverse n (Apply _ l) v c = trace' ("traverse Apply " ++ show n ++ "\n") $ + traverse n l v c +traverse n (Fail m m2ls) v c = trace' ("traverse Fail " ++ show m ++ " " ++ show' n v c ++ " length m2ls = " ++ show (length m2ls) ++ "\n") $ + foldr ((\ (w,l) c' -> if v + w < c' then traverse (n - 1 ) l (v+w) c' + else c') . ($m)) c m2ls +traverse n (End_h (a, lf) r) v c = trace' ("traverse End_h " ++ show' n v c ++ "\n") $ + traverse n (lf a `best` removeEnd_h r) v c +traverse n (End_f (l :_) r) v c = trace' ("traverse End_f " ++ show' n v c ++ "\n") $ + traverse n (l `best` r) v c +traverse n (End_f [] r) v c = error "Cannot traverse End_f with empty list" +traverse n (Done _ ) v c = trace' ("traverse Done " ++ show' n v c ++ " choosing " ++ show v ++ "\n") + v show' :: (Show a, Show b, Show c) => a -> b -> c -> String show' n v c = "n: " ++ show n ++ " v: " ++ show v ++ " c: " ++ show c diff --git a/uu-parsinglib.cabal b/uu-parsinglib.cabal --- a/uu-parsinglib.cabal +++ b/uu-parsinglib.cabal @@ -1,14 +1,13 @@ Name: uu-parsinglib -Version: 2.9.1.1 +Version: 2.9.2 Build-Type: Simple License: MIT Copyright: S Doaitse Swierstra License-file: LICENSE Author: Doaitse Swierstra, Utrecht University -Maintainer: Doaitse Swierstra -Stability: stable, but evolving -Homepage: http://www.cs.uu.nl/wiki/bin/view/HUT/ParserCombinators -Bug-reports: mailto:doaitse@swierstra.net +Maintainer: Jeroen Bransen +Stability: stable +Bug-reports: https://github.com/UU-ComputerScience/uu-parsinglib/issues Synopsis: Fast, online, error-correcting, monadic, applicative, merging, permuting, interleaving, idiomatic parser combinators. Description: New version of the Utrecht University parser combinator library, which provides online, error correction, annotation free, applicative style parser combinators. In addition to this we provide a monadic and an idomatic interface. @@ -30,14 +29,15 @@ We maintain a low frequency mailing for discussing the package. You can subscribe at: Category: Parsing,Text,ParserCombinators -cabal-version: >= 1.6 +cabal-version: >= 1.10 source-repository head - type: svn - location: https://svn.science.uu.nl/repos/project.STEC.uu-parsinglib/trunk + type: git + location: https://github.com/UU-ComputerScience/uu-parsinglib Library hs-source-dirs: src + default-language: Haskell2010 Build-Depends: base >= 4.2 && <5, time, ListLike >= 3.0.1, uu-interleaved >= 0.1.0 && < 0.3