Various strictness changes

Text/XML/Light/Cursor.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE Strict #-}
 --------------------------------------------------------------------
 -- |
 -- Module    : Text.XML.Light.Cursor

Text/XML/Light/Input.hs

@@ -1,3 +1,7 @@
+{-# OPTIONS_GHC -ddump-simpl -ddump-stg -ddump-to-file #-}
+{-# LANGUAGE Strict #-}
+{-# LANGUAGE StrictData #-}
+{-# LANGUAGE BangPatterns #-}
 --------------------------------------------------------------------
 -- |
 -- Module    : Text.XML.Light.Input
@@ -61,14 +65,14 @@ nodes ns ps (TokText txt : ts) =
 
   in (Text txt { cdData = cdData txt ++ more } : es1, qs, ts1)
 
-nodes cur_info ps (TokStart p t as empty : ts) = (node : siblings, open, toks)
+nodes cur_info ps (TokStart p t as empty : ts) = (node `seq` node : siblings, open, toks)
   where
-  new_name  = annotName new_info t
-  new_info  = foldr addNS cur_info as
-  node      = Elem Element { elLine    = Just p
+  !new_name  = annotName new_info t
+  !new_info  = foldr addNS cur_info as
+  !node      = Elem Element { elLine    = Just p
                            , elName    = new_name
                            , elAttribs = map (annotAttr new_info) as
-                           , elContent = children
+                           , elContent = forceList children `seq` children
                            }
 
   (children,(siblings,open,toks))

Text/XML/Light/Lexer.hs

@@ -1,4 +1,8 @@
 {-# LANGUAGE TypeSynonymInstances #-}
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE StrictData #-}
+{-# LANGUAGE Strict #-}
+{-# OPTIONS_GHC -ddump-to-file -ddump-simpl -ddump-stg #-}
 
 module Text.XML.Light.Lexer where
 
@@ -116,9 +120,9 @@ special c cs =
                    } : tokens' ts
   where munch acc nesting ((_,'>') : ds)
          | nesting == (0::Int) = ('>':acc,ds)
-         | otherwise           = munch ('>':acc) (nesting-1) ds
+	 | otherwise           = munch ('>':acc) (nesting-1) ds
         munch acc nesting ((_,'<') : ds)
-         = munch ('<':acc) (nesting+1) ds
+	 = munch ('<':acc) (nesting+1) ds
         munch acc n ((_,x) : ds) = munch (x:acc) n ds
         munch acc _ [] = (acc,[]) -- unterminated DTD markup
 
@@ -167,9 +171,10 @@ attribs cs        = case cs of
                                   in (a:as,b,ts)
 
 attrib             :: LString -> (Attr,LString)
-attrib cs           = let (ks,cs1)  = qualName cs
+attrib cs           = let (!ks,cs1)  = qualName cs
                           (vs,cs2)  = attr_val (dropSpace cs1)
-                      in ((Attr ks (decode_attr vs)),dropSpace cs2)
+                          !a = decode_attr vs
+                      in ((Attr ks a),dropSpace cs2)
 
 attr_val           :: LString -> (String,LString)
 attr_val ((_,'=') : cs) = string (dropSpace cs)
@@ -193,18 +198,22 @@ string cs           = breakn eos cs
 
 
 break' :: (a -> Bool) -> [(b,a)] -> ([a],[(b,a)])
-break' p xs         = let (as,bs) = breakn p xs
+break' p xs         = let (!as,!bs) = breakn p xs
                       in (as, case bs of
                                 [] -> []
                                 _ : cs -> cs)
 
 breakn :: (a -> Bool) -> [(b,a)] -> ([a],[(b,a)])
 breakn p l = (map snd as,bs) where (as,bs) = break (p . snd) l
 
-
+forceList :: [a] -> ()
+forceList [] = ()
+forceList (!x:xs) = x `seq` forceList xs
 
 decode_attr :: String -> String
-decode_attr cs = concatMap cvt (decode_text cs)
+decode_attr cs =
+  let !res = concatMap cvt (decode_text cs)
+  in forceList res `seq` res
   where cvt (TxtBit x) = x
         cvt (CRefBit x) = case cref_to_char x of
                             Just c -> [c]
@@ -217,8 +226,9 @@ decode_text xs@('&' : cs) = case break (';' ==) cs of
                               (as,_:bs) -> CRefBit as : decode_text bs
                               _ -> [TxtBit xs]
 decode_text []  = []
-decode_text cs  = let (as,bs) = break ('&' ==) cs
-                  in TxtBit as : decode_text bs
+decode_text cs  = let !(!as,!bs) = break ('&' ==) cs
+                      !decoded = decode_text bs
+                  in TxtBit as : decoded
 
 cref_to_char :: [Char] -> Maybe Char
 cref_to_char cs = case cs of

Text/XML/Light/Output.hs

@@ -36,7 +36,7 @@ data ConfigPP = ConfigPP
   , prettify      :: Bool
   }
 
--- | Default pretty printing configuration.
+-- | Default pretty orinting configuration.
 --  * Always use abbreviate empty tags.
 defaultConfigPP :: ConfigPP
 defaultConfigPP = ConfigPP { shortEmptyTag = const True

Text/XML/Light/Types.hs

@@ -12,6 +12,7 @@
 --
 
 {-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE StrictData #-}
 module Text.XML.Light.Types where
 
 import Data.Typeable(Typeable)

xml.cabal

@@ -1,30 +1,33 @@
-Name:            xml
-Version:         1.3.14
-Homepage:        https://github.com/GaloisInc/xml/
-Synopsis:        A simple XML library.
-Description:     A simple XML library.
-Category:        Text, XML
-License:         BSD3
-License-File:    LICENSE
-Author:          Galois Inc.
-Maintainer:      diatchki@galois.com
-Copyright:       (c) 2007-2008 Galois Inc.
-Build-type:      Simple
-Cabal-version:   >= 1.6
-
-
-library
-  Build-depends:   base >= 3 && < 5, bytestring, text
-  Ghc-options:     -Wall -O2
-  Exposed-modules: Text.XML.Light,
-                   Text.XML.Light.Types,
-                   Text.XML.Light.Output,
-                   Text.XML.Light.Input,
-                   Text.XML.Light.Lexer,
-                   Text.XML.Light.Proc
-                   Text.XML.Light.Cursor
-  Extensions:      FlexibleInstances
-
-source-repository head
-  type:       git
-  location:   git://github.com/GaloisInc/xml.git
+Name:            xml
+Version:         1.3.14
+x-revision: 2
+Homepage:        https://github.com/GaloisInc/xml
+Synopsis:        A simple XML library.
+Description:     A simple XML library.
+Category:        Text, XML
+License:         BSD3
+License-File:    LICENSE
+Author:          Galois Inc.
+Maintainer:      diatchki@galois.com
+Copyright:       (c) 2007-2008 Galois Inc.
+Build-type:      Simple
+Cabal-version:   >= 1.6
+
+
+library
+  Build-depends:   base >= 3 && < 5, bytestring, text
+  Ghc-options:     -Wall -O2
+  Exposed-modules: Text.XML.Light,
+                   Text.XML.Light.Types,
+                   Text.XML.Light.Output,
+                   Text.XML.Light.Input,
+                   Text.XML.Light.Lexer,
+                   Text.XML.Light.Proc
+                   Text.XML.Light.Cursor
+  Extensions:      FlexibleInstances
+  default-extensions: Strict
+
+source-repository head
+  type:       git
+  location:   git://github.com/GaloisInc/xml.git
+