packages feed

sequor 0.2 → 0.2.2

raw patch · 26 files changed

+702/−463 lines, 26 filesdep +textdep −hashabledep −utf8-string

Dependencies added: text

Dependencies removed: hashable, utf8-string

Files

Makefile view
@@ -1,13 +1,20 @@-INCLUDES=lib/haskell-utils+INCLUDES=lib  all:run 	 -lib/haskell-utils:-	svn co http://ws9lx.lsv.uni-saarland.de/repos/gchrupala/haskell-utils/ lib/haskell-utils--run: lib/haskell-utils+run:  	ghc --make -O2 -isrc:$(INCLUDES) -o bin/sequor src/ghc_rts_opts.c src/Main.hs++cabal:+	runghc Setup.lhs configure --user --prefix=`pwd` --bindir=`pwd`/bin/ &&\+        runghc Setup.lhs build && runghc Setup.lhs install +cabal-static:+	runghc Setup.lhs configure --user --prefix=`pwd` --bindir=`pwd`/bin/ \+             --ghc-option="-optl-static" --ghc-option="-optl-pthread" &&\+	runghc Setup.lhs build && runghc Setup.lhs install +	-rm -rf dist+	-rm -rf share  clean: 	-find . -name '*.o'  | xargs rm
README view
@@ -1,4 +1,4 @@-sequor 0.2+sequor 0.2.2  AUTHOR: Grzegorz Chrupała <gchrupala@lsv.uni-saarland.de> @@ -7,7 +7,9 @@ meant mainly for NLP applications such as Part of Speech tagging, syntactic chunking or Named Entity labeling.  +INSTALLATION +See installation instructions: http://code.google.com/p/sequor/wiki/INSTALL  USAGE @@ -43,8 +45,9 @@ As an example we can use data annotated with syntactic chunk labels in the data directory. For example: -./bin/sequor train data/all.features data/train.conll data/devel.conll model\-	     --rate 0.1 --beam 10 --iter 5 --min-count 50 --hash+./bin/sequor train data/all.features data/train.conll  model\+	     --rate 0.1 --beam 10 --iter 5 --min-count 50 --hash\+             --heldout data/devel.conll  ./bin/sequor predict model < data/test.conll > data/test.labels
data/all.features view
@@ -1,8 +1,8 @@ Cat [ Index (Cell 0 0)-    , Rect 0 1 0 10 +    , Rect 0 1 0 100      , MarkNull (Cell -1 0)-    , Rect -1 1 -1 10-    , Rect -2 0 -2 10+    , Rect -1 1 -1 100+    , Rect -2 0 -2 100     , Row 1      , Row 2     ]
+ data/mlcomp.features view
@@ -0,0 +1,14 @@+Cat [ Index (Cell 0 0)+    , Lower (Cell 0 0)+    , Suffix 3 (Cell 0 0)+    , Suffix 2 (Cell 0 0)+    , Suffix 1 (Cell 0 0)+    , WordShape (Cell 0 0)+    , Rect 0 1 0 100 +    , MarkNull (Cell -1 0)+    , Rect -1 1 -1 100+    , Rect -2 0 -2 100+    , Row 1 +    , Row 2+    ]+
+ data/mlcomp2.features view
@@ -0,0 +1,29 @@+Cat [ Index (Cell 0 0)+    , Lower (Cell 0 0)++    , Suffix 4 (Cell 0 0)+    , Suffix 3 (Cell 0 0)+    , Suffix 2 (Cell 0 0)+    , Suffix 1 (Cell 0 0)++    , Prefix 4 (Cell 0 0)+    , Prefix 3 (Cell 0 0)+    , Prefix 2 (Cell 0 0)+    , Prefix 1 (Cell 0 0)++    , WordShape (Cell 0 0)+    , WordShape (Cell -1 0)+    , WordShape (Cell 1 0)+    +    , Cat [Cell -1 0, Cell 0 0]+    , Cat [Cell 0 0, Cell 1 0 ]++    , Rect 0 1 0 100 +    , MarkNull (Cell -1 0)+    , Rect -1 1 -1 100+    , Rect -2 0 -2 100+    , Row 1 +    , Row 2+    ]++
+ lib/Aux/Atom.hs view
@@ -0,0 +1,88 @@+{-# LANGUAGE  GeneralizedNewtypeDeriving +            , NoMonomorphismRestriction +            , BangPatterns #-}+module Aux.Atom +    ( MonadAtoms (..)+    , AtomTable (..)+    , Atoms+    , AtomsT+    , empty+    , evalAtoms+    , evalAtomsT+    , runAtoms+    , runAtomsT+    )+where+import Control.Monad.State+import Control.Monad.Identity+import qualified Data.Map as Map+import qualified Data.IntMap as IntMap+import qualified Data.Binary as B+import qualified Aux.Text as Text+type Txt = Text.Txt+++data AtomTable = T { lastID :: !Int +                   , to :: Map.Map Txt Int +                   , from :: IntMap.IntMap Txt } +                   deriving (Eq,Show)+++instance B.Binary AtomTable where+    put t = do B.put (lastID t) +               B.put (to t)+               B.put (from t)+    get = do liftM3 T B.get B.get B.get+++class Monad m => MonadAtoms m where+    toAtom :: Txt -> m Int+    maybeToAtom :: Txt -> m (Maybe Int)+    fromAtom :: Int -> m Txt+    table    :: m AtomTable++instance Monad m => MonadAtoms (AtomsT m) where+    toAtom x = AtomsT $ do+      t <- get+      case Map.lookup x (to t) of+        Just j -> return $! j+        Nothing -> do +                 let i = lastID t+                     i' = i + 1 +                     !t' = t { lastID = i'+                             , to = Map.insert x  i (to t) +                             , from = IntMap.insert i x (from t) }+                 put t'+                 return $! lastID t++    maybeToAtom x = +        AtomsT $ do+          t <- get+          return . Map.lookup x . to $ t+            +    fromAtom i = AtomsT $ do+      t <- get+      return $ (from t) IntMap.! i+    table = AtomsT get++empty :: AtomTable+empty = T 0 Map.empty IntMap.empty++runAtomsT :: AtomsT t t1 -> AtomTable -> t (t1, AtomTable)+runAtomsT (AtomsT x) s = runStateT x s++runAtoms :: Atoms t -> AtomTable -> (t, AtomTable)+runAtoms (Atoms x) s = runIdentity (runAtomsT x s)+++evalAtoms :: Atoms t -> t+evalAtoms = fst . flip runAtoms empty++evalAtomsT :: (Monad m) => AtomsT m a -> m a+evalAtomsT = liftM fst . flip runAtomsT empty++newtype AtomsT m r = AtomsT (StateT AtomTable m r)+    deriving (Functor,Monad,MonadTrans,MonadIO)++newtype Atoms r = Atoms (AtomsT Identity r)+    deriving (Functor,Monad,MonadAtoms)
+ lib/Aux/Commands.hs view
@@ -0,0 +1,62 @@+module Aux.Commands +    ( Command+    , CommandName+    , Help+    , CommandSpec (..)+    , module System.Console.GetOpt+    , defaultMain+    , usage+    )+where+import Text.PrettyPrint(renderStyle,render,nest,vcat,hsep,style+                       ,Mode(..),mode,text,(<>),($$),($+$),(<+>))+import System.Console.GetOpt+import System.Environment (getArgs)+import System.IO (stderr,hPutStr)+import qualified Data.List as List+++type Command opts = (opts -> [String] -> IO ())+type CommandName = String+type Help        = String+data CommandSpec opts =  CommandSpec (Command opts)+                                  Help     +                                  [OptDescr (opts -> opts)]+                                  [String]++defaultMain :: opts -> [(String, CommandSpec opts)] -> String -> IO ()+defaultMain def commands header = do+  args <- getArgs+  let theUsage = usage commands header+  case args of+    []           -> theUsage []+    command:opts -> case List.lookup command commands of+                      Nothing   -> theUsage  ["Invalid command: " ++ command]+                      Just spec -> runCommand theUsage def spec opts++runCommand :: ([String] -> IO ()) +           -> opts +           -> CommandSpec opts +           -> [String] +           -> IO ()+runCommand theUsage def (CommandSpec command help optDesc argnames) args = +    case getOpt Permute optDesc args of+      (o,n,[]  ) ->  command (foldr ($) def o) n+      (_,_,errs) -> theUsage errs++usage :: [(String, CommandSpec t)] -> String -> [String] -> IO ()+usage commands header errs = hPutStr stderr . render +                             $  vcat (List.map text errs)+                             $$ usageMsg commands header++usageMsg commands header = +        text header+    $+$ (vcat (List.map commandUsage commands))++commandUsage (name , CommandSpec command help optionDesc args) = +    text name <> text ":"+    $$ (nest 10 (text help))+    $$ (text name <+> text (if null optionDesc then "" else "[OPTION...]")+                  <+> hsep (map text args))+    <+>  (nest 10 (text $ usageInfo "" optionDesc))+
+ lib/Aux/ListZipper.hs view
@@ -0,0 +1,76 @@+module Aux.ListZipper +    ( +     ListZipper(..)+    , focus+    , left+    , right+    , reset+    , fromList+    , toZippers+    , toList+    , next+    , atEnd +    , at+    )+where+import Data.Maybe+import Data.Monoid+import Data.Foldable (Foldable,foldMap)+++data ListZipper a = LZ [a] (Maybe a) [a]  deriving (Show,Eq,Ord)++left :: ListZipper a -> [a]+left  (LZ xs _ _) = xs++focus :: ListZipper a -> Maybe a+focus (LZ _ x _)  = x++right :: ListZipper a -> [a]+right (LZ _ _ ys) = ys++fromList []     = LZ [] Nothing [] +fromList (x:xs) = LZ [] (Just x) xs++toZippers xs = let zs = iterate next . fromList $ xs+               in map snd . zip xs $ zs++toList (LZ xs (Just x) ys) = reverse xs ++ [x] ++ ys+toList (LZ xs Nothing [])  = reverse xs++next :: ListZipper a -> ListZipper a+next = nextWith id id+nextWith f g (LZ lxs (Just x) rxs)  =+    case rxs of+      y:ys -> LZ (f x:lxs) (Just (g y)) ys+      []   -> LZ (f x:lxs) Nothing []++atEnd :: ListZipper a -> Bool+atEnd = isNothing . focus++reset (LZ [] (Just y) ys)     = LZ [] (Just y) ys+reset (LZ [] Nothing [])      = LZ [] Nothing []+reset (LZ xs (Just y) ys) = LZ [] (Just z) (zs++[y]++ys)+    where z:zs = reverse xs                    +reset (LZ xs Nothing [])  = LZ [] (Just z) zs+    where z:zs = reverse xs++from :: (Monoid m) => Maybe m -> m+from Nothing  = mempty+from (Just x) = x++index 1 (x:xs)  = Just x+index i []  = Nothing+index i (x:xs) = index (i-1) xs++at :: (Monoid m) =>  ListZipper m -> Int -> m+at  z 0 = from . focus $ z+at  z i | i < 0 = from .  index (negate i) . left  $ z+at  z i         = from .  index i          . right $ z++instance Functor ListZipper where+    fmap f (LZ ls x rs) = LZ (fmap f ls) (fmap f x) (fmap f rs) +instance Foldable ListZipper where+    foldMap f (LZ ls x rs) = mconcat $ fmap f (reverse ls) +                             ++ [from $ fmap f x] ++ fmap f rs+
+ lib/Aux/Text.hs view
@@ -0,0 +1,111 @@+{-# LANGUAGE OverloadedStrings +  , TypeSynonymInstances +  #-}+module Aux.Text +    ( Txt+    , module Data.Text.Lazy+    , module Data.Text.Lazy.Encoding+    , splitOn+    , show+    , read+    , reads+    , readDouble+    , readInt+    , normalize+    , fromString+    , toString+    , getContents+    , readFile   +    , writeFile +    , putStr    +    , putStrLn  +    , interact +    , hPutStr +    , hPutStrLn+    )+    where+import Data.Text.Lazy hiding (splitOn)+import Data.Text.Lazy.Encoding+import Data.Text.Lazy.Read+import System.IO (Handle)+import qualified Data.Text.Lazy.IO as IO+import qualified Data.ByteString.Lazy.Char8 as ByteString+import qualified Data.Text as Strict+import Data.Binary+import qualified Aux.Utils as Utils+import Prelude hiding ( show+                      , reverse+                      , map+                      , read+                      , reads+                      , getContents+                      , readFile   +                      , writeFile +                      , putStr    +                      , putStrLn  +                      , interact +                      )+import qualified Prelude++type Txt = Text++instance Binary Txt where+    put = put . encodeUtf8+    get = fmap decodeUtf8 get++splitOn :: Char -> Txt -> [Txt]+splitOn c = Prelude.map pack . Utils.splitOn c . unpack++show :: (Show a) => a -> Txt+show = pack . Prelude.show++read :: (Read a) => Txt -> a+read = Prelude.read . unpack++reads :: (Read a) => Txt -> [(a,Txt)]+reads = Prelude.map (\ (r,s) -> (r,pack s)) . Prelude.reads . unpack++readDouble :: Txt -> Double +readDouble t = case double t of+                 Right (d,"") -> d+                 Left err -> error err++readInt :: Txt -> Int+readInt t = case decimal t of+              Right (d,"") -> d+              Left err -> error err++fromString :: String -> Txt+fromString = pack++toString :: Txt -> String+toString = unpack++normalize :: Txt -> Txt+normalize = fromChunks . return . Strict.concat . toChunks++getContents :: IO Txt+getContents = decodeUtf8 `fmap` ByteString.getContents++readFile :: FilePath -> IO Txt+readFile  f = decodeUtf8 `fmap` ByteString.readFile f++writeFile :: FilePath -> Txt -> IO ()+writeFile f = ByteString.writeFile f . encodeUtf8++putStr :: Txt -> IO ()+putStr = ByteString.putStr . encodeUtf8++putStrLn :: Txt -> IO ()+putStrLn = ByteString.putStrLn . encodeUtf8++interact :: (Txt -> Txt) -> IO ()+interact f  = ByteString.interact (encodeUtf8 . f . decodeUtf8)++hPutStr :: Handle -> Txt -> IO ()+hPutStr h = ByteString.hPutStr h . encodeUtf8++hPutStrLn :: Handle -> Txt -> IO ()+hPutStrLn h s = do ByteString.hPutStr h . encodeUtf8 $ s+                   ByteString.hPutStr h . encodeUtf8 $ "\n"+
+ lib/Aux/Utils.hs view
@@ -0,0 +1,44 @@+{-# LANGUAGE BangPatterns #-}++module Aux.Utils +    ( splitOn+    , splitWith+    , padRight+    , uniq+    , accuracy+    , mean+    , (#)+    )+where+import Data.List (foldl')+import qualified Data.Set as Set+import qualified Data.Map as Map++splitOn :: (Eq a) => a -> [a] -> [[a]]+splitOn = splitWith . (==)++splitWith ::  (a -> Bool) -> [a] -> [[a]]+splitWith f s =  case dropWhile f s of+                   [] -> []+                   s' -> w : splitWith f s''+                       where (w, s'') = break f s'++padRight :: a -> Int -> [a] -> [a]+padRight x i xs = take i (xs ++ repeat x)++uniq :: (Ord a) => [a] -> [a]+uniq = Set.toList . Set.fromList++accuracy predicted testset  = +    fromIntegral (foldl' (+) 0 (zipWith ((fromEnum .) . (==)) predicted +                                                              testset))+                              / +                              fromIntegral (length testset)++{-# SPECIALIZE mean :: [Double] -> Double #-}+mean :: (Fractional a) => [a] -> a+mean =   uncurry (/) +       . foldl' (\ (!s,!n) x -> (s+x,n+1)) (0,0)++(#) :: (Show k,Ord k) => Map.Map k a -> k -> a+m # i = Map.findWithDefault (error $ "#: not found: " ++ show i) i m
− lib/haskell-utils/Atom.hs 
@@ -1,85 +0,0 @@-{-# LANGUAGE  GeneralizedNewtypeDeriving , NoMonomorphismRestriction #-}-module Atom ( MonadAtoms (..)-            , AtomTable (..)-            , Atoms-            , AtomsT-            , empty-            , evalAtoms-            , evalAtomsT-            , runAtoms-            , runAtomsT-            )-where-import Control.Monad.State-import Control.Monad.Identity-import qualified Data.Map as Map-import qualified Data.IntMap as IntMap-import qualified Data.Binary as B-import qualified Text-type Txt = Text.Txt---data AtomTable = T { lastID :: !Int -                   , to :: Map.Map Txt Int -                   , from :: IntMap.IntMap Txt } -                   deriving (Eq,Show)---instance B.Binary AtomTable where-    put t = do B.put (lastID t) -               B.put (to t)-               B.put (from t)-    get = do liftM3 T B.get B.get B.get---class Monad m => MonadAtoms m where-    toAtom :: Txt -> m Int-    maybeToAtom :: Txt -> m (Maybe Int)-    fromAtom :: Int -> m Txt-    table    :: m AtomTable--instance Monad m => MonadAtoms (AtomsT m) where-    toAtom x = AtomsT $ do-      t <- get-      case Map.lookup x (to t) of-        Just j -> return $! j-        Nothing -> do -                 let i = lastID t-                     i' = i + 1 -                     !t' = t { lastID = i'-                             , to = Map.insert x  i (to t) -                             , from = IntMap.insert i x (from t) }-                 put t'-                 return $! lastID t--    maybeToAtom x = -        AtomsT $ do-          t <- get-          return . Map.lookup x . to $ t-            -    fromAtom i = AtomsT $ do-      t <- get-      return $ (from t) IntMap.! i-    table = AtomsT get--empty :: AtomTable-empty = T 0 Map.empty IntMap.empty--runAtomsT :: AtomsT t t1 -> AtomTable -> t (t1, AtomTable)-runAtomsT (AtomsT x) s = runStateT x s--runAtoms :: Atoms t -> AtomTable -> (t, AtomTable)-runAtoms (Atoms x) s = runIdentity (runAtomsT x s)---evalAtoms :: Atoms t -> t-evalAtoms = fst . flip runAtoms empty--evalAtomsT :: (Monad m) => AtomsT m a -> m a-evalAtomsT = liftM fst . flip runAtomsT empty--newtype AtomsT m r = AtomsT (StateT AtomTable m r)-    deriving (Functor,Monad,MonadTrans,MonadIO)--newtype Atoms r = Atoms (AtomsT Identity r)-    deriving (Functor,Monad,MonadAtoms)
− lib/haskell-utils/Commands.hs 
@@ -1,63 +0,0 @@-module Commands -    ( Command-    , CommandName-    , Help-    , CommandSpec (..)-    , module System.Console.GetOpt-    , defaultMain-    , usage-    )-where-import Text.PrettyPrint(renderStyle,render,nest,vcat,hsep,style-                       ,Mode(..),mode,text,(<>),($$),($+$),(<+>))-import System.Console.GetOpt-import System.Environment (getArgs)-import System.IO (stderr)-import System.IO.UTF8 (hPutStr)-import qualified Data.List as List---type Command opts = (opts -> [String] -> IO ())-type CommandName = String-type Help        = String-data CommandSpec opts =  CommandSpec (Command opts)-                                  Help     -                                  [OptDescr (opts -> opts)]-                                  [String]--defaultMain :: opts -> [(String, CommandSpec opts)] -> String -> IO ()-defaultMain def commands header = do-  args <- getArgs-  let theUsage = usage commands header-  case args of-    []           -> theUsage []-    command:opts -> case List.lookup command commands of-                      Nothing   -> theUsage  ["Invalid command: " ++ command]-                      Just spec -> runCommand theUsage def spec opts--runCommand :: ([String] -> IO ()) -           -> opts -           -> CommandSpec opts -           -> [String] -           -> IO ()-runCommand theUsage def (CommandSpec command help optDesc argnames) args = -    case getOpt Permute optDesc args of-      (o,n,[]  ) ->  command (foldr ($) def o) n-      (_,_,errs) -> theUsage errs--usage :: [(String, CommandSpec t)] -> String -> [String] -> IO ()-usage commands header errs = hPutStr stderr . render -                             $  vcat (List.map text errs)-                             $$ usageMsg commands header--usageMsg commands header = -        text header-    $+$ (vcat (List.map commandUsage commands))--commandUsage (name , CommandSpec command help optionDesc args) = -    text name <> text ":"-    $$ (nest 10 (text help))-    $$ (text name <+> text (if null optionDesc then "" else "[OPTION...]")-                  <+> hsep (map text args))-    <+>  (nest 10 (text $ usageInfo "" optionDesc))-
− lib/haskell-utils/ListZipper.hs 
@@ -1,69 +0,0 @@-module ListZipper ( ListZipper(..)-                  , focus-                  , left-                  , right-                  , reset-                  , fromList-                  , toWindows-                  , toList-                  , next-                  , atEnd -                  , at-                  )-where-import Data.Maybe-import Data.Monoid-import Data.Foldable (Foldable,foldMap)---data ListZipper a = LZ [a] (Maybe a) [a]  deriving (Show,Eq,Ord)---left  (LZ xs _ _) = xs-focus (LZ _ x _)  = x-right (LZ _ _ ys) = ys--fromList []     = LZ [] Nothing [] -fromList (x:xs) = LZ [] (Just x) xs--toWindows xs = let zs = iterate next . fromList $ xs-               in map snd . zip xs $ zs--toList (LZ xs (Just x) ys) = reverse xs ++ [x] ++ ys-toList (LZ xs Nothing [])  = reverse xs--next :: ListZipper a -> ListZipper a-next = nextWith id id-nextWith f g (LZ lxs (Just x) rxs)  =-    case rxs of-      y:ys -> LZ (f x:lxs) (Just (g y)) ys-      []   -> LZ (f x:lxs) Nothing []--atEnd = isNothing . focus--reset (LZ [] (Just y) ys)     = LZ [] (Just y) ys-reset (LZ [] Nothing [])      = LZ [] Nothing []-reset (LZ xs (Just y) ys) = LZ [] (Just z) (zs++[y]++ys)-    where z:zs = reverse xs                    -reset (LZ xs Nothing [])  = LZ [] (Just z) zs-    where z:zs = reverse xs--from :: (Monoid m) => Maybe m -> m-from Nothing  = mempty-from (Just x) = x--index 1 (x:xs)  = Just x-index i []  = Nothing-index i (x:xs) = index (i-1) xs--at :: (Monoid m) =>  ListZipper m -> Int -> m-at  z 0 = from . focus $ z-at  z i | i < 0 = from .  index (negate i) . left  $ z-at  z i         = from .  index i          . right $ z--instance Functor ListZipper where-    fmap f (LZ ls x rs) = LZ (fmap f ls) (fmap f x) (fmap f rs) -instance Foldable ListZipper where-    foldMap f (LZ ls x rs) = mconcat $ fmap f (reverse ls) -                             ++ [from $ fmap f x] ++ fmap f rs-
− lib/haskell-utils/Text.hs 
@@ -1,85 +0,0 @@-module Text ( Txt-            , StrictTxt-            , module Data.ByteString.Lazy.UTF8-            , Char8.unlines-            , Char8.words-            , Char8.unwords-            , Char8.append-            , Char8.concat-            , Char8.null-            , Char8.readInt--            , BS.getContents-            , BS.readFile-            , BS.writeFile-            , BS.putStr-            , BS.putStrLn-            , BS.interact-            , BS.hPutStr--            , map-            , all-            , show-            , read-            , reverse-            , normalize-            , toStrict-            , fromStrict-            , takeWhile-            , dropWhile-            , isPrefixOf-            , isSuffixOf-            , splitOn-            )-where-import Data.ByteString.Lazy.UTF8-import qualified Data.ByteString.Lazy.Char8 as Char8-import qualified Data.ByteString.Lazy as BS-import qualified Data.ByteString.Char8 as Strict -import Prelude hiding (show,reverse,map,read,takeWhile,dropWhile,break,all)-import qualified Prelude-import qualified Utils --type Txt = ByteString-type StrictTxt = Strict.ByteString--show :: (Show a) => a -> Txt-show = fromString . Prelude.show--read :: (Read a) => Txt -> a-read = Prelude.read . toString--reverse :: Txt -> Txt-reverse = fromString . Prelude.reverse . toString--map :: (Char -> Char) -> Txt -> Txt-map f = fromString . Prelude.map f . toString  -- FIXME--all :: (Char -> Bool) -> Txt -> Bool-all f = Prelude.all f . toString--normalize :: Txt -> Txt-normalize = Char8.fromChunks . return . Strict.concat . Char8.toChunks--toStrict :: Txt -> StrictTxt-toStrict = Strict.concat . Char8.toChunks--fromStrict :: StrictTxt -> Txt-fromStrict = Char8.fromChunks . return--takeWhile :: (Char -> Bool) -> Txt -> Txt-takeWhile f = fst . break (not . f)--dropWhile :: (Char -> Bool) -> Txt -> Txt-dropWhile f = snd . break (not . f)--isPrefixOf :: Txt -> Txt -> Bool-xs `isPrefixOf` ys = Prelude.all id . Char8.zipWith (==) xs $ ys--isSuffixOf :: Txt -> Txt -> Bool-xs `isSuffixOf` ys =  reverse xs `isPrefixOf` Char8.reverse ys---splitOn :: Char -> Txt -> [Txt]-splitOn c = Prelude.map fromString . Utils.splitOn c . toString-
− lib/haskell-utils/Utils.hs 
@@ -1,43 +0,0 @@-{-# LANGUAGE BangPatterns #-}--module Utils ( splitOn-             , splitWith-             , padRight-             , uniq-             , accuracy-             , mean-             , (#)-             )-where-import Data.List (foldl')-import qualified Data.Set as Set-import qualified Data.Map as Map--splitOn :: (Eq a) => a -> [a] -> [[a]]-splitOn = splitWith . (==)--splitWith ::  (a -> Bool) -> [a] -> [[a]]-splitWith f s =  case dropWhile f s of-                   [] -> []-                   s' -> w : splitWith f s''-                       where (w, s'') = break f s'--padRight :: a -> Int -> [a] -> [a]-padRight x i xs = take i (xs ++ repeat x)--uniq :: (Ord a) => [a] -> [a]-uniq = Set.toList . Set.fromList--accuracy predicted testset  = -    fromIntegral (foldl' (+) 0 (zipWith ((fromEnum .) . (==)) predicted -                                                              testset))-                              / -                              fromIntegral (length testset)--{-# SPECIALIZE mean :: [Double] -> Double #-}-mean :: (Fractional a) => [a] -> a-mean =   uncurry (/) -       . foldl' (\ (!s,!n) x -> (s+x,n+1)) (0,0)--(#) :: (Show k,Ord k) => Map.Map k a -> k -> a-m # i = Map.findWithDefault (error $ "#: not found: " ++ show i) i m
sequor.cabal view
@@ -1,5 +1,5 @@ Name:                sequor-Version:             0.2+Version:             0.2.2 Description:         A sequence labeler based on Collins's sequence perceptron. Synopsis:	     A sequence labeler based on Collins's sequence perceptron. Homepage:	     http://code.google.com/p/sequor/@@ -12,19 +12,22 @@ Category:            Natural Language Processing Extra-source-files:  README, Makefile Data-dir:  	     data-Data-files:	     all.features, example.features, train.conll-		     devel.conll, test.conll+Data-files:	     all.features, example.features, mlcomp.features,+                     mlcomp2.features, +                     train.conll, devel.conll, test.conll  Executable sequor   Main-is:           Main.hs-  Other-modules:     ListZipper, Utils, Text, CorpusReader, Atom, +  Other-modules:     Aux.ListZipper, Aux.Utils, Aux.Text, +                     Aux.Atom, Aux.Commands, CorpusReader,                      FeatureTemplate, Config, Perceptron.Vector,-                     Perceptron.Sequence, Features, Labeler, Commands+                     Perceptron.Sequence, Features, Labeler, Hashable   Build-Depends:     base >= 3 && < 5, containers >= 0.2, -                     bytestring >= 0.9, utf8-string >= 0.3,+                     bytestring >= 0.9,                      binary >= 0.5, mtl >= 1.1,                      vector >= 0.5, array >= 0.2, pretty >= 1.0,-                     hashable >= 1.0-  hs-source-dirs:    src,lib/haskell-utils-  ghc-options:	     -O2-  c-sources:	     src/ghc_rts_opts.c+                     text >= 0.10+  hs-source-dirs:    src,lib+  ghc-options:	     -O2 -rtsopts+  c-sources:	     src/ghc_rts_opts.c +
src/Config.hs view
@@ -3,7 +3,7 @@     ( Config (..), Flags(..) ) where import Data.Char-import Atom (AtomTable)+import Aux.Atom (AtomTable) import qualified Data.Binary as B import Control.Monad (ap) import FeatureTemplate (Feature)@@ -22,6 +22,7 @@ data Config = Config { atomTable :: AtomTable                       , featureTemplate :: Feature                      , flags :: Flags+                     , fieldNum :: !Int                      }  instance B.Binary Flags where@@ -31,8 +32,8 @@  instance B.Binary Config where     get = let g = B.get-          in return Config `ap` g `ap` g `ap` g +          in return Config `ap` g `ap` g `ap` g `ap` g -    put (Config a b c) =+    put (Config a b c d) =         let p = B.put -        in p a >> p b >> p c +        in p a >> p b >> p c >> p d
src/CorpusReader.hs view
@@ -6,19 +6,19 @@     , fromWords     ) where-import ListZipper -import Utils (splitWith)-import qualified Text-import Text (Txt)+import Aux.ListZipper +import Aux.Utils (splitWith)+import qualified Aux.Text as Text+import Aux.Text (Txt) import Data.Maybe (isJust)   type Token = [Txt] -corpus :: Txt -> [[ListZipper Token]]-corpus =+corpus :: Int -> Txt -> [[ListZipper Token]]+corpus len =       map toZippers-    . map (map $ parseFields)+    . map (map $ parseFields . take len)     . splitWith null     . map Text.words     . Text.lines @@ -40,6 +40,4 @@ parseFields :: [Txt] -> Token parseFields ws = ws -toZippers :: [a] -> [ListZipper a]-toZippers = takeWhile (isJust . focus) . iterate next . fromList
src/FeatureTemplate.hs view
@@ -1,10 +1,15 @@+{-# LANGUAGE OverloadedStrings #-} module FeatureTemplate      ( Feature(..)      , parse+    , maybeParse     ) where import Data.Binary -import Text+import Aux.Text(Txt)+import qualified Aux.Text as Text+import qualified Data.List as List+import qualified Data.Char as Char  type Row = Int type Col = Int@@ -24,10 +29,30 @@     deriving (Show,Read)  parse :: Txt -> Feature-parse =  Text.read . Text.unwords . Text.lines+parse =  maybe (error $ "FeatureTemplate.parse: no parse") id . maybeParse  +maybeParse :: Txt -> Maybe Feature+maybeParse s = +    case +      Text.reads+    . Text.unwords+    . map uncomment+    . Text.lines+    $ s+    of +      (f,r):_ | Text.all Char.isSpace r -> Just f+      _                                 -> Nothing++uncomment :: Txt -> Txt +uncomment s = let splits = map (flip Text.splitAt s) +                               [1..fromIntegral . Text.length $ s]+              in case List.find (("--"`Text.isPrefixOf`) . snd) splits of+                   Nothing -> s+                   Just (prefix,_) -> prefix+ instance Binary Feature where     put f = put $ Text.show f     get = do       f <- get       return $ Text.read f+
src/Features.hs view
@@ -10,26 +10,28 @@     ) where -import qualified Text-import Text (Txt)-import qualified ListZipper as LZ-import ListZipper (ListZipper,at)+import qualified Aux.Text as Text+import Aux.Text (Txt)+import qualified Aux.ListZipper as LZ+import Aux.ListZipper (ListZipper,at) import CorpusReader (Token,fromWords) import qualified Data.Char as Char import Data.List (group,sort) import qualified Data.IntSet as IntSet import qualified Data.IntMap as IntMap-import Atom (MonadAtoms,AtomTable,from,toAtom,maybeToAtom)+import Aux.Atom (MonadAtoms,AtomTable,from,toAtom,maybeToAtom) import Data.Maybe (catMaybes,isNothing) import Control.Monad (liftM2) import Data.Monoid (mappend) import Config  import qualified Data.Vector.Unboxed as V import FeatureTemplate (Feature(..))-import Data.Hashable (hash)-import Data.Word (Word)+import Data.Word (Word,Word64)+import qualified Hashable as H+import Data.Int -toAtom' size s = hash s `mod` size+toAtom' :: Int -> Txt -> Int+toAtom' size s = fromIntegral ((H.hash s::Word64) `rem` fromIntegral size)  iNDEX_SUFFIX :: Txt iNDEX_SUFFIX="::index"@@ -85,7 +87,7 @@  inputFeatures :: Config -> ListZipper Token  -> [Txt] inputFeatures config x =-    catMaybes . prefixIndex oUTPUT_PREFIX  . eval x . featureTemplate $ config+    catMaybes . prefixIndex iNPUT_PREFIX  . eval x . featureTemplate $ config  outputFeatures :: [Txt] -> [Txt] outputFeatures ys = catMaybes . prefixIndex oUTPUT_PREFIX . map Just $@@ -126,7 +128,7 @@                                             +++ x )                            [1..] -(+++) = liftM2 Text.append+(+++) = liftM2 (\s t -> Text.concat [s,t])  index [] _     = Nothing index (x:_)  0 = Just x
+ src/Hashable.hs view
@@ -0,0 +1,107 @@+{-# LANGUAGE TypeSynonymInstances  #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Hashable+-- Copyright   :  (c) Milan Straka 2010, Grzegorz Chrupala 2010+-- License     :  BSD3+-- Stability   :  provisional+-- Portability :  portable+--+-- 'Hashable' class for hashable types, with instances for basic types. The only+-- function of this class is+--+-- @+--   'hash' :: (Bits b, Hashable h) => h -> b+-- @+--+-- Adapted from Milan Straka's code by Grzegorz Chrupala: +-- Removed FFI and C dependency +-- Use Bits b instead of hardcoded Int as a result type of 'hash'+-----------------------------------------------------------------------------++module Hashable ( Hashable(..)+                , combine+                ) where++import Data.Bits+import Data.Int+import Data.Word+import Data.List (foldl')+import qualified Data.ByteString as B+import qualified Data.ByteString.Lazy as BL+import qualified Aux.Text as Text++-- | The class containing a function 'hash' which computes the hash values of+-- given value.+class Hashable a where+    -- | The computed 'hash' value should be as collision-free as possible, the+    -- probability of @'hash' a == 'hash' b@ should ideally be 1 over the+    -- number of representable values in the result type.+    hash :: Bits b => a -> b++-- | Combines two given hash values.+combine :: (Bits b) => b -> b -> b+combine h1 h2 = (h1 + h1 `shiftL` 5) `xor` h2++hashAndCombine :: (Bits b,Hashable h) => b -> h -> b+hashAndCombine acc h = acc `combine` hash h++instance Hashable () where hash _ = 0++instance Hashable Bool where hash x = case x of { True -> 1; False -> 0 }++instance Hashable Int where hash = fromIntegral+instance Hashable Int8 where hash = fromIntegral+instance Hashable Int16 where hash = fromIntegral+instance Hashable Int32 where hash = fromIntegral+instance Hashable Int64 where hash = fromIntegral++instance Hashable Word where hash = fromIntegral+instance Hashable Word8 where hash = fromIntegral+instance Hashable Word16 where hash = fromIntegral+instance Hashable Word32 where hash = fromIntegral+instance Hashable Word64 where hash = fromIntegral++instance Hashable Char where hash = fromIntegral . fromEnum++instance Hashable a => Hashable (Maybe a) where+    hash Nothing = 0+    hash (Just a) = 42 `combine` hash a++instance (Hashable a1, Hashable a2) => Hashable (a1, a2) where+    hash (a1, a2) = hash a1 `combine` hash a2++instance (Hashable a1, Hashable a2, Hashable a3) => Hashable (a1, a2, a3) where+    hash (a1, a2, a3) = hash a1 `combine` hash a2 `combine` hash a3++instance (Hashable a1, Hashable a2, Hashable a3, Hashable a4) => Hashable (a1, a2, a3, a4) where+    hash (a1, a2, a3, a4) = hash a1 `combine` hash a2 `combine` hash a3 `combine` hash a4++instance (Hashable a1, Hashable a2, Hashable a3, Hashable a4, Hashable a5)+      => Hashable (a1, a2, a3, a4, a5) where+    hash (a1, a2, a3, a4, a5) =+      hash a1 `combine` hash a2 `combine` hash a3 `combine` hash a4 `combine` hash a5++instance (Hashable a1, Hashable a2, Hashable a3, Hashable a4, Hashable a5, Hashable a6)+      => Hashable (a1, a2, a3, a4, a5, a6) where+    hash (a1, a2, a3, a4, a5, a6) =+      hash a1 `combine` hash a2 `combine` hash a3 `combine` hash a4 `combine` hash a5 `combine` hash a6++instance (Hashable a1, Hashable a2, Hashable a3, Hashable a4, Hashable a5, Hashable a6, Hashable a7)+      => Hashable (a1, a2, a3, a4, a5, a6, a7) where+    hash (a1, a2, a3, a4, a5, a6, a7) =+      hash a1 `combine` hash a2 `combine` hash a3 `combine` hash a4 `combine` hash a5 `combine` hash a6 `combine` hash a7++instance Hashable a => Hashable [a] where+    {-# SPECIALIZE instance Hashable [Char] #-}+    hash = foldl' hashAndCombine 0++instance Hashable B.ByteString where+    hash = B.foldl' (\z b -> (z * 33) `xor` fromIntegral b) 0++instance Hashable BL.ByteString where +    hash = BL.foldl' (\z b -> (z * 33) `xor` fromIntegral b) 0+           --  BLInt.foldlChunks hashAndCombine 0++instance Hashable Text.Txt where+    hash = hash . Text.encodeUtf8
src/Labeler.hs view
@@ -14,21 +14,21 @@ import qualified Data.IntSet as IntSet import Data.List (foldl',tails) import Data.Maybe (fromMaybe)-import ListZipper+import Aux.ListZipper import qualified Perceptron.Sequence as P import Perceptron.Sequence (Options(..)) import CorpusReader (Token)-import Utils (splitWith,uniq)+import Aux.Utils (splitWith,uniq) import Text.Printf-import Atom+import Aux.Atom import Control.Monad.RWS import Features (inputFeatures,features,maybeFeatures,outputFeatures                 ,indexFeatures) import qualified Data.Array as A import qualified Data.Vector.Unboxed as V import qualified Data.Binary as Binary-import qualified Text-import Text(Txt)+import qualified Aux.Text as Text+import Aux.Text(Txt) import Data.Char import Data.Maybe (catMaybes) import Config
src/Main.hs view
@@ -2,12 +2,14 @@ where import qualified Labeler as L  import CorpusReader (corpus,corpusLabeled)-import qualified Text+import qualified Aux.Text as Text+import qualified Aux.ListZipper as Z import qualified Data.Binary as Binary+import qualified Data.ByteString.Lazy as ByteString import System.Environment (getArgs) import System.IO (hPutStrLn,stderr) import FeatureTemplate (parse)-import Commands ( CommandSpec (..),defaultMain , usage +import Aux.Commands ( CommandSpec (..),defaultMain , usage                  , Command                 , OptDescr(Option), ArgDescr(ReqArg,NoArg)) import Config(Flags(..))@@ -65,20 +67,24 @@   testdat <- case flagHeldout flags of                Nothing -> return []                Just testf -> fmap corpusLabeled $ Text.readFile testf-  let conf = L.Config {  L.featureTemplate = template +  let len = case   fmap length . Z.focus . (\(x:_) -> x) . fst . (\(x:_) -> x) +                 $ traindat of+              Just i -> i+      conf = L.Config {  L.featureTemplate = template                        ,  L.atomTable = error                                         "main:Config.atomTable undefined"                        ,  L.flags = flags+                      ,  L.fieldNum = len                       }-  Text.writeFile outf  +  ByteString.writeFile outf             . Binary.encode            . L.train conf traindat            $ testdat  predict :: Command Flags predict flags [modelf] = do-  m <- fmap Binary.decode (Text.readFile modelf)-  testdat <- fmap corpus $ Text.getContents+  m <- fmap Binary.decode (ByteString.readFile modelf)+  testdat <- fmap (corpus (L.fieldNum . L.config $ m)) $ Text.getContents   Text.putStr            . Text.unlines            . map Text.unlines @@ -86,7 +92,7 @@           $ testdat  version :: Command Flags -version _ _ = putStrLn "sequor-0.2"+version _ _ = putStrLn "sequor-0.2.2"  help :: Command Flags help _ _ = usage commands msg []@@ -95,3 +101,4 @@ main = defaultMain defaultFlags commands msg  msg =    "Usage: sequor command [OPTION...] [ARG...]"+
src/Perceptron/Sequence.hs view
@@ -17,7 +17,8 @@ import Data.Array.Unboxed import qualified Data.Array as A import qualified Data.Vector.Unboxed as V-import Control.Monad.ST+import Control.Monad.ST +import qualified Control.Monad.ST.Unsafe as ST.Unsafe import Data.STRef import Control.Monad import qualified Data.Map as Map@@ -29,19 +30,18 @@ import Config  import Data.List (inits,foldl',sortBy) import Data.Ord (comparing)-import ListZipper +import Aux.ListZipper  import qualified Data.Binary as Binary-import Utils (uniq)+import Aux.Utils (uniq)  data Model = Model { options :: Options                     , weights :: UArray I Float } type X = [Xi] type Y = [Yi]-type I = (Yi,Xii)  type Xi = V.Vector Xii type Xii = Int type Yi = Int-type Dot = LocalSparseVector Yi Xii -> Float+type Dot = Local -> Float  data Options = Options { oYMap       :: YMap                        , oIndexSet   :: IntSet.IntSet@@ -115,11 +115,11 @@ decode m = fst . decode' (options m) (weights m `dot`)   data Cell = Cell { cScore :: !Float-                 , cPhi   :: SparseVector I+                 , cPhi   :: Global                  , cPath  :: Y                  , cStep  :: ListZipper Xi  } deriving (Show,Eq) -decode' :: Options -> Dot -> X -> (Y,SparseVector I)+decode' :: Options -> Dot -> X -> (Y,Global) decode' opts w x =    bestPath opts w [Cell { cScore = 0                          , cPhi = Map.empty@@ -127,20 +127,20 @@                         , cStep = fromList x } ]  -phi :: Options -> X -> Y -> SparseVector I+phi :: Options -> X -> Y -> Global phi opts x y = foldl' f Map.empty . zip x . map reverse . tail . inits $ y     where f z (xi,ys) = z `plus` toSV  (features (oYMap opts) xi ys)  {-# INLINE features #-}          -features :: YMap -> Xi -> [Yi] -> LocalSparseVector Yi Xii+features :: YMap -> Xi -> [Yi] -> Local features (!zero,uni,bi) xi (y:ys) =      case ys of-      []            -> (y, zero V.++  xi)-      [y1]          -> (y, uni A.! y1 V.++ xi)+      []            -> (Local y $ zero V.++  xi)+      [y1]          -> (Local y $ uni A.! y1 V.++ xi)       (y1 : y2 : _) -> let r = bi A.! (y1,y2)                         in  if V.null r -                           then  (y, uni A.! y1  V.++ xi)-                           else  (y, r           V.++ xi)+                           then  (Local y $ uni A.! y1  V.++ xi)+                           else  (Local y $ r           V.++ xi)  beamSearch ::  Options            -> Dot@@ -159,7 +159,7 @@                                                , cPhi = ph                                                 , cPath = ys                                                 , cStep = x } <- cs -                               , let Just xi = focus x::Maybe Xi+                               , let Just xi = focus x                                , y' <- yDictFind opts xi                                ]                    in f . take (oBeam opts) @@ -170,7 +170,7 @@ bestPath :: Options             -> Dot             -> [Cell]-            -> (Y, SparseVector I)+            -> (Y, Global) bestPath opts w xs =    let xs' =  beamSearch opts w xs       first =  (\(x:_) -> x) xs'@@ -182,7 +182,7 @@ iter :: Options          -> Int         -> [(X,Y)]-        -> (STRef s Int, DenseVectorST s I, DenseVectorST s I)+        -> (STRef s Int, WeightsST s, WeightsST s)         -> ST s () iter opts _ ss (c,params,params_a) = do     for_ ss $ \ (x,y) -> do@@ -226,9 +226,9 @@   {-# NOINLINE runLogger #-}-runLogger f = unsafeIOToST f+runLogger f = ST.Unsafe.unsafeIOToST f -finalParams :: (STRef s Int, DenseVectorST s I, DenseVectorST s I) +finalParams :: (STRef s Int, WeightsST s, WeightsST s)              -> ST s () finalParams (c,params,params_a) = do   (l,u) <- getBounds params@@ -247,8 +247,8 @@                 . unzip                 $ xys     in case oFeatBounds opts of-         Just (xl',xh') -> ((yl,xl'),(yh,xh'))-         Nothing        -> ((yl,xl),(yh,xh))+         Just (xl',xh') -> (I yl xl',I yh xh')+         Nothing        -> (I yl xl,I yh xh)     where f ((!miny,!minx),(!maxy,!maxx)) (xs,!y) =               ((min miny y,V.minimum $ minx`V.cons`xs)               ,(max maxy y,V.maximum $ maxx`V.cons`xs))
src/Perceptron/Vector.hs view
@@ -1,9 +1,10 @@ {-# LANGUAGE FlexibleContexts , BangPatterns #-} module Perceptron.Vector  -    ( SparseVector-    , LocalSparseVector-    , DenseVector-    , DenseVectorST+    ( I(..)+    , Global+    , Local(..)+    , Weights+    , WeightsST     , toSV     , for_     , plus_@@ -23,62 +24,68 @@ import Control.Monad import qualified Data.Map as Map import Data.List (foldl',sort)-import Config import qualified Data.Vector.Unboxed as V+import Data.Binary +data I = I {-# UNPACK #-} !Int {-# UNPACK #-} !Int deriving (Eq,Ord,Ix,Show)+instance Binary I where +    put (I i j) = put (i,j)+    get = uncurry I `fmap` get -type SparseVector i = Map.Map i Float-type LocalSparseVector y i = (y,V.Vector i)-type DenseVectorST s i = STUArray s i Float-type DenseVector i = UArray i Float+type Global = Map.Map I Float+data Local  = Local {-# UNPACK #-} !Int !(V.Vector Int)+type WeightsST s = STUArray s I Float+type Weights = UArray I Float    for_ xs f = mapM_ f xs -plus_ :: (Show i,Ix i) => DenseVectorST s i -> SparseVector i -> ST s ()+plus_ :: WeightsST s -> Global -> ST s () plus_ w v = do   for_ (Map.toList v) $ \(i,vi) -> do               wi <- readArray w i                writeArray w i (wi + vi) minus_ w v = plus_ w (v `scale` (-1)) -scale :: (Ix i)  => SparseVector i -> Float -> SparseVector i+scale :: Global -> Float -> Global scale v n = Map.map (*n) v -plus :: (Ix i)  => SparseVector i -> SparseVector i -> SparseVector i+plus :: Global -> Global -> Global plus u v = Map.unionWith (+) u v-minus :: (Ix i)  => SparseVector i -> SparseVector i -> SparseVector i+minus :: Global -> Global -> Global minus u v = u `plus` (v `scale` (-1))  -dot :: DenseVector (Int,Int) -> LocalSparseVector Int Int -> Float+dot :: Weights -> Local -> Float {-# INLINE dot #-}-dot w (!y,x) = V.foldl' (\ !z !i -> z + w ! (y,i)) 0 x-{--dot w (!y,v) = go 0 v-    where go !s [] = s-          go !s (!i:v) = go (s + w ! (y,i)) v--}+dot w (Local !y x) = V.foldl' (\ !z !i -> z + w ! I y i) 0 x+-- For some reason explicit loop doesn't help here+-- dot !w (Local y x) = go 0 0+--     where !len = V.length x+--           go !z !j | j == len = z+--           go !z !j = go (z + w ! I y (x V.! j)) (j+1) -dot' :: (Float,DenseVector (Int,Int),DenseVector (Int,Int)) -     -> LocalSparseVector Int Int -     -> Float++dot' :: (Float,Weights,Weights) -> Local -> Float {-# INLINE dot' #-}-dot' (!c,params,params_a) (!y,x) = V.foldl' (\ !z !i -> -                                                 let e   = params   ! (y,i)-                                                     e_a = params_a ! (y,i)-                                                 in z + (e - (e_a * (1/c))))-                                            0-                                            x-{--dot' (!c,params,params_a) (!y,x) = go 0 x-  where go !s [] = s-        go !s (!i:x) = -            let e   = params   ! (y,i)-                e_a = params_a ! (y,i)-            in go (s + (e - (e_a * (1/c)))) x--}+-- dot' (!c,!params,!params_a) (Local y x) = V.foldl' (\ !z !j -> +--                                                     let i   = I y j+--                                                         e   = params   ! i +--                                                         e_a = params_a ! i+--                                                  in z + (e - (e_a / c)))+--                                             0+--                                             x -toSV :: (V.Unbox i, Ord y,Ord i) => LocalSparseVector y i -> SparseVector (y,i)-toSV (y,v) = Map.fromList [ ((y,i),1) | i <- V.toList v ]++dot' (!c,!params,!params_a) (Local y x) = go 0 0+    where !len = V.length x+          go !z !j | j == len = z+          go !z !j = +              let i   = I y (x V.! j)+                  e   = params   ! i+                  e_a = params_a ! i+              in  go (z + (e - (e_a / c))) (j+1)++toSV :: (V.Unbox Int) => Local -> Global+toSV (Local y v) = Map.fromList [ (I y i,1) | i <- V.toList v ]
src/ghc_rts_opts.c view
@@ -1,1 +1,1 @@-char *ghc_rts_opts = "-K100m";+char *ghc_rts_opts = "-K100m -H500m";