msyds/gf-core
1
0
Fork 0
forked from GitHub/gf-core
Code Pull Requests Activity

PGFService: make the restriction on parallelism more effective

Browse Source 
Restrict the entire request handler instead of just the call to the C parser.
This commit is contained in:
hallgren
2015-02-25 16:08:21 +00:00
parent 0764d518c7
commit 5cf0ab4110
4 changed files with 12 additions and 6 deletions
Download Patch File Download Diff File Expand all files Collapse all files

3
gf.cabal
View File

@@ -76,7 +76,8 @@ Library
utf8-string, utf8-string,
random, random,
pretty, pretty,
mtl mtl,
exceptions
hs-source-dirs: src/runtime/haskell hs-source-dirs: src/runtime/haskell
if flag(custom-binary) if flag(custom-binary)

12
src/server/PGFService.hs
View File

@@ -35,6 +35,7 @@ import Control.Concurrent
import qualified Control.Exception as E import qualified Control.Exception as E
import Control.Monad import Control.Monad
import Control.Monad.State(State,evalState,get,put) import Control.Monad.State(State,evalState,get,put)
import Control.Monad.Catch(bracket_)
import Data.Char import Data.Char
import Data.Function (on) import Data.Function (on)
import Data.List (sortBy,intersperse,mapAccumL,nub,isSuffixOf,nubBy) import Data.List (sortBy,intersperse,mapAccumL,nub,isSuffixOf,nubBy)
@@ -52,6 +53,8 @@ import Fold(fold) -- transfer function for OpenMath LaTeX
catchIOE :: IO a -> (E.IOException -> IO a) -> IO a catchIOE :: IO a -> (E.IOException -> IO a) -> IO a
catchIOE = E.catch catchIOE = E.catch
withQSem qsem = bracket_ (liftIO $ waitQSem qsem) (liftIO $ signalQSem qsem)
logFile :: FilePath logFile :: FilePath
logFile = "pgf-error.log" logFile = "pgf-error.log"
@@ -124,9 +127,11 @@ getFile get path =
--cpgfMain :: String -> (C.PGF,MVar ParseCache) -> CGI CGIResult --cpgfMain :: String -> (C.PGF,MVar ParseCache) -> CGI CGIResult
cpgfMain qsem command (t,(pgf,pc)) = cpgfMain qsem command (t,(pgf,pc)) =
case command of case command of
"c-parse" -> out t=<< join (parse # input % start % limit % trie) "c-parse" -> withQSem qsem $
out t=<< join (parse # input % start % limit % trie)
"c-linearize" -> out t=<< lin # tree % to "c-linearize" -> out t=<< lin # tree % to
"c-translate" -> out t=<< join (trans # input % to % start % limit % trie) "c-translate" -> withQSem qsem $
out t=<< join (trans # input % to % start % limit % trie)
"c-lookupmorpho"-> out t=<< morpho # from1 % textInput "c-lookupmorpho"-> out t=<< morpho # from1 % textInput
"c-flush" -> out t=<< flush "c-flush" -> out t=<< flush
"c-grammar" -> out t grammar "c-grammar" -> out t grammar
@@ -160,8 +165,7 @@ cpgfMain qsem command (t,(pgf,pc)) =
-- Without caching parse results: -- Without caching parse results:
parse' start mlimit ((from,concr),input) = parse' start mlimit ((from,concr),input) =
liftIO $ E.bracket_ (waitQSem qsem) (signalQSem qsem) return $ maybe id take mlimit . drop start # cparse
(return $! maybe id take mlimit . drop start # cparse)
where where
--cparse = C.parse concr cat input --cparse = C.parse concr cat input
cparse = C.parseWithHeuristics concr cat input (-1) callbacks cparse = C.parseWithHeuristics concr cat input (-1) callbacks

2
src/server/exec/pgf-fcgi.hs
View File

@@ -5,7 +5,7 @@ import Network.FastCGI(runFastCGI,runFastCGIConcurrent')
import PGFService(cgiMain,newPGFCache,stderrToFile,logFile) import PGFService(cgiMain,newPGFCache,stderrToFile,logFile)
main = do stderrToFile logFile main = do stderrToFile logFile
fcgiMain =<< newPGFCache fcgiMain =<< newPGFCache Nothing
fcgiMain cache = fcgiMain cache =

1
src/server/gf-server.cabal
View File

@@ -38,6 +38,7 @@ Library
cgi >= 3001.1.7.3, cgi >= 3001.1.7.3,
httpd-shed>=0.4.0.2, httpd-shed>=0.4.0.2,
mtl, mtl,
exceptions,
network>=2.3 && <2.6, network>=2.3 && <2.6,
json >= 0.3.3, json >= 0.3.3,
utf8-string >= 0.3.1.1, utf8-string >= 0.3.1.1,