diff --git a/gf.cabal b/gf.cabal
index 3a5f2822e..11830ddf0 100644
--- a/gf.cabal
+++ b/gf.cabal
@@ -67,29 +67,15 @@ flag network-uri
description: Get Network.URI from the network-uri package
default: True
---flag new-comp
--- Description: Make -new-comp the default
--- Default: True
-
-flag c-runtime
- Description: Include functionality from the C run-time library (which must be installed already)
- Default: False
-
-
executable gf
- hs-source-dirs: src/programs, src/runtime/haskell/binary
+ hs-source-dirs: src/programs
main-is: gf-main.hs
default-language: Haskell2010
- build-depends: base, filepath, directory, time, time-compat, old-locale, pretty, mtl, array, random,
+ build-depends: pgf2, base, filepath, directory, time, time-compat, old-locale, pretty, mtl, array, random,
process, haskeline, parallel>=3, exceptions, bytestring, utf8-string, containers
ghc-options: -threaded
- if flag(c-runtime)
- build-depends: pgf2
- else
- build-depends: pgf
-
if impl(ghc>=7.0)
ghc-options: -rtsopts -with-rtsopts=-I5
if impl(ghc<7.8)
@@ -223,9 +209,6 @@ executable gf
Data.Binary.Builder
Data.Binary.IEEE754
- if flag(c-runtime)
- cpp-options: -DC_RUNTIME
-
if flag(server)
build-depends: httpd-shed>=0.4.0.3, network>=2.3 && <2.7, json,
cgi>=3001.2.2.0
diff --git a/src/compiler/GF/Compile/GenerateBC.hs b/src/compiler/GF/Compile/GenerateBC.hs
index d6d6f255c..d89792677 100644
--- a/src/compiler/GF/Compile/GenerateBC.hs
+++ b/src/compiler/GF/Compile/GenerateBC.hs
@@ -9,7 +9,6 @@ import qualified Data.Map as Map
import Data.List(nub,mapAccumL)
import Data.Maybe(fromMaybe)
-#if C_RUNTIME
generateByteCode :: SourceGrammar -> Int -> [L Equation] -> [[Instr]]
generateByteCode gr arity eqs =
let (bs,instrs) = compileEquations gr arity (arity+1) is
@@ -302,7 +301,3 @@ freeVars xs e = collectOp (freeVars xs) e
push_is :: Int -> Int -> [IVal] -> [IVal]
push_is i 0 is = is
push_is i n is = ARG_VAR i : push_is (i-1) (n-1) is
-
-#else
-generateByteCode = error "generateByteCode is not implemented"
-#endif
diff --git a/src/compiler/GF/Infra/BuildInfo.hs b/src/compiler/GF/Infra/BuildInfo.hs
index f0230246b..cba9bc0d0 100644
--- a/src/compiler/GF/Infra/BuildInfo.hs
+++ b/src/compiler/GF/Infra/BuildInfo.hs
@@ -14,9 +14,3 @@ buildInfo =
#ifdef SERVER_MODE
++" server"
#endif
-#ifdef NEW_COMP
- ++" new-comp"
-#endif
-#ifdef C_RUNTIME
- ++" c-runtime"
-#endif
diff --git a/src/compiler/GF/Infra/SIO.hs b/src/compiler/GF/Infra/SIO.hs
index 75c57601b..453b94348 100644
--- a/src/compiler/GF/Infra/SIO.hs
+++ b/src/compiler/GF/Infra/SIO.hs
@@ -12,9 +12,6 @@ module GF.Infra.SIO(
newStdGen,print,putStr,putStrLn,
-- ** Specific to GF
importGrammar,importSource,
-#ifdef C_RUNTIME
- readPGF2,
-#endif
putStrLnFlush,runInterruptibly,lazySIO,
-- * Restricted accesss to arbitrary (potentially unsafe) IO operations
-- | If the environment variable GF_RESTRICTED is defined, these
@@ -39,9 +36,6 @@ import qualified System.Random as IO(newStdGen)
import qualified GF.Infra.UseIO as IO(getLibraryDirectory)
import qualified GF.System.Signal as IO(runInterruptibly)
import qualified GF.Command.Importing as GF(importGrammar, importSource)
-#ifdef C_RUNTIME
-import qualified PGF2
-#endif
-- * The SIO monad
@@ -123,7 +117,3 @@ lazySIO = lift1 lazyIO
importGrammar pgf opts files = lift0 $ GF.importGrammar pgf opts files
importSource opts files = lift0 $ GF.importSource opts files
-
-#ifdef C_RUNTIME
-readPGF2 = lift0 . PGF2.readPGF
-#endif
diff --git a/src/compiler/GF/Server.hs b/src/compiler/GF/Server.hs
index de0ec6abc..477f41e7c 100644
--- a/src/compiler/GF/Server.hs
+++ b/src/compiler/GF/Server.hs
@@ -179,7 +179,7 @@ handle logLn documentroot state0 cache execute1 stateVar
translatePath rpath = rootrpath -- hmm, check for ".."
- versionInfo (c1,c2) =
+ versionInfo c =
html200 . unlines $
"":
"":
@@ -187,8 +187,7 @@ handle logLn documentroot state0 cache execute1 stateVar
"":
(""++hdr++"
"):
(zipWith (++) ("":repeat "
") buildinfo)++
- sh "Haskell run-time system" c1++
- sh "C run-time system" c2
+ sh "Run-time system" c
where
hdr:buildinfo = lines gf_version
rel = makeRelative documentroot
diff --git a/src/server/PGFService.hs b/src/server/PGFService.hs
index 1774a8cff..23ecba22c 100644
--- a/src/server/PGFService.hs
+++ b/src/server/PGFService.hs
@@ -4,6 +4,7 @@ module PGFService(cgiMain,cgiMain',getPath,
Caches,pgfCache,newPGFCache,flushPGFCache,listPGFCache) where
import PGF (PGF,Labels,CncLabels)
+import PGF2
import GF.Text.Lexing
import qualified PGF
import Cache
@@ -15,11 +16,6 @@ import CGI(CGI,readInput,getInput,getVarWithDefault,
Accept(..),Language(..),negotiate,liftIO)
import URLEncoding
-#if C_RUNTIME
-import qualified PGF2 as C
---import Data.Time.Clock(getCurrentTime,diffUTCTime)
-#endif
-
import Data.Time.Clock(UTCTime)
import Data.Time.Format(formatTime)
#if MIN_VERSION_time(1,5,0)
@@ -60,43 +56,18 @@ withQSem qsem = bracket_ (liftIO $ waitQSem qsem) (liftIO $ signalQSem qsem)
logFile :: FilePath
logFile = "pgf-error.log"
-#ifdef C_RUNTIME
-data Caches = Caches { pgfCache::Cache PGF,
- labelsCache::Cache Labels,
- cncLabelsCache::Cache CncLabels,
- cpgfCache::(Cache (C.PGF,({-MVar ParseCache-})),QSem) }
---type Caches = (Cache PGF,Cache (C.PGF,({-MVar ParseCache-})))
---type ParseCache = Map.Map (String,String) (ParseResult,UTCTime)
---type ParseResult = Either String [(C.Expr,Float)]
+data Caches = Caches { qsem :: QSem,
+ pgfCache :: Cache PGF,
+ labelsCache :: Cache Labels }
-newPGFCache jobs = do pgfCache <- newCache' PGF.readPGF
- lblCache <- newCache' (fmap PGF.getDepLabels . readFile)
- clblCache <- newCache'(fmap PGF.getCncDepLabels .readFile)
- let n = maybe 4 id jobs
+newPGFCache jobs = do let n = maybe 4 id jobs
qsem <- newQSem n
- cCache <- newCache' $ \ path -> do pgf <- C.readPGF path
- --pc <- newMVar Map.empty
- return (pgf,({-pc-}))
- return $ Caches pgfCache lblCache clblCache (cCache,qsem)
+ pgfCache <- newCache' PGF.readPGF
+ lblCache <- newCache' (fmap PGF.getDepLabels . readFile)
+ return $ Caches qsem pgfCache lblCache
flushPGFCache c = do flushCache (pgfCache c)
flushCache (labelsCache c)
- flushCache (fst (cpgfCache c))
-listPGFCache c = (,) # listCache (pgfCache c) % listCache (fst (cpgfCache c))
-#else
-data Caches = Caches { pgfCache::Cache PGF,
- labelsCache::Cache Labels,
- cncLabelsCache::Cache CncLabels }
-newPGFCache _ = do pgfCache <- newCache' PGF.readPGF
- lblCache <- newCache' (fmap PGF.getDepLabels . readFile)
- clblCache <- newCache'(fmap PGF.getCncDepLabels .readFile)
- return $ Caches pgfCache lblCache clblCache
-flushPGFCache c = flushCache (pgfCache c)
-
-listPGFCache :: Caches -> IO ([(FilePath,UTCTime)],[(FilePath,UTCTime)])
-listPGFCache c = (,) # listCache (pgfCache c) % return []
-#endif
-
-labelsCaches c = (labelsCache c,cncLabelsCache c)
+listPGFCache c = listCache (pgfCache c)
newCache' rd = do c <- newCache rd
forkIO $ forever $ clean c
@@ -121,20 +92,8 @@ cgiMain' cache path =
(getInput "command")
case command of
"download" -> outputBinary =<< getFile BS.readFile path
- 'c':'-':_ -> optionalCpgfMain cache path command
_ -> do tpgf <- getFile (readCache' (pgfCache cache)) path
- pgfMain (labelsCaches cache) path command tpgf
-
-optionalCpgfMain cache path command =
-#ifdef C_RUNTIME
- cpgfMain (snd (cpgfCache cache)) command
- =<< getFile (readCache' (fst (cpgfCache cache))) path
-#else
- serverError "Server configured without C run-time support" ""
-
-serverError = throw 500
-
-#endif
+ pgfMain (qsem cache) command tpgf
getFile get path =
either failed return =<< liftIO (E.try (get path))
@@ -143,38 +102,34 @@ getFile get path =
then notFound path
else liftIO $ ioError e
---------------------------------------------------------------------------------
--- * C run-time functionality
-#ifdef C_RUNTIME
---cpgfMain :: String -> (C.PGF,MVar ParseCache) -> CGI CGIResult
-cpgfMain qsem command (t,(pgf,pc)) =
+pgfMain qsem command (t,pgf) =
case command of
- "c-parse" -> withQSem qsem $
+ "parse" -> withQSem qsem $
out t=<< join (parse # input % start % limit % treeopts)
- "c-linearize" -> out t=<< lin # tree % to
- "c-linearizeAll"-> out t=<< linAll # tree % to
- "c-translate" -> withQSem qsem $
+ "linearize" -> out t=<< lin # tree % to
+ "linearizeAll"-> out t=<< linAll # tree % to
+ "translate" -> withQSem qsem $
out t=< out t=<< morpho # from1 % textInput
- "c-flush" -> out t=<< flush
- "c-grammar" -> out t grammar
- "c-abstrtree" -> outputGraphviz=<< C.graphvizAbstractTree pgf C.graphvizDefaults # tree
- "c-parsetree" -> outputGraphviz=<< (\cnc -> C.graphvizParseTree cnc C.graphvizDefaults) . snd # from1 %tree
- "c-wordforword" -> out t =<< wordforword # input % to
- _ -> badRequest "Unknown command" command
+ "lookupmorpho"-> out t=<< morpho # from1 % textInput
+ "flush" -> out t=<< flush
+ "grammar" -> out t grammar
+ "abstrtree" -> outputGraphviz=<< graphvizAbstractTree pgf graphvizDefaults # tree
+ "parsetree" -> outputGraphviz=<< (\cnc -> graphvizParseTree cnc graphvizDefaults) . snd # from1 %tree
+ "wordforword" -> out t =<< wordforword # input % to
+ _ -> badRequest "Unknown command" command
where
flush = liftIO $ do --modifyMVar_ pc $ const $ return Map.empty
performGC
return $ showJSON ()
- cat = C.startCat pgf
- langs = C.languages pgf
+ cat = startCat pgf
+ langs = languages pgf
grammar = showJSON $ makeObj
- ["name".=C.abstractName pgf,
+ ["name".=abstractName pgf,
"lastmodified".=show t,
- "startcat".=C.showType [] (C.startCat pgf),
+ "startcat".=showType [] (startCat pgf),
"languages".=languages]
where
languages = [makeObj ["name".= l] | (l,_)<-Map.toList langs]
@@ -189,40 +144,23 @@ cpgfMain qsem command (t,(pgf,pc)) =
good trees = "trees".=map tp trees :[] -- :addTrie trie trees
tp (tree,prob) = makeObj (addTree json tree++["prob".=prob])
- -- Without caching parse results:
parse' start mlimit ((from,concr),input) =
- case C.parseWithHeuristics concr cat input (-1) callbacks of
- C.ParseOk ts -> return (Right (maybe id take mlimit (drop start ts)))
- C.ParseFailed _ tok -> return (Left tok)
- C.ParseIncomplete -> return (Left "")
+ case parseWithHeuristics concr cat input (-1) callbacks of
+ ParseOk ts -> return (Right (maybe id take mlimit (drop start ts)))
+ ParseFailed _ tok -> return (Left tok)
+ ParseIncomplete -> return (Left "")
where
- callbacks = maybe [] cb $ lookup (C.abstractName pgf) C.literalCallbacks
+ callbacks = maybe [] cb $ lookup (abstractName pgf) literalCallbacks
cb fs = [(cat,f pgf (from,concr) input)|(cat,f)<-fs]
-{-
- -- Caching parse results:
- parse' start mlimit ((from,concr),input) =
- liftIO $ do t <- getCurrentTime
- fmap (maybe id take mlimit . drop start)
- # modifyMVar pc (parse'' t)
- where
- key = (from,input)
- parse'' t pc = maybe new old $ Map.lookup key pc
- where
- new = return (update (res,t) pc,res)
- where res = C.parse concr cat input
- old (res,_) = return (update (res,t) pc,res)
- update r = Map.mapMaybe purge . Map.insert key r
- purge r@(_,t') = if diffUTCTime t t'<120 then Just r else Nothing
- -- remove unused parse results after 2 minutes
--}
+
linAll tree to = showJSON (linAll' tree to)
linAll' tree (tos,unlex) =
[makeObj ["to".=to,
- "texts".=map unlex (C.linearizeAll c tree)]|(to,c)<-tos]
+ "texts".=map unlex (linearizeAll c tree)]|(to,c)<-tos]
lin tree to = showJSON (lin' tree to)
lin' tree (tos,unlex) =
- [makeObj ["to".=to,"text".=unlex (C.linearize c tree)]|(to,c)<-tos]
+ [makeObj ["to".=to,"text".=unlex (linearize c tree)]|(to,c)<-tos]
trans input@((from,_),_) to start mlimit (trie,jsontree) =
do parses <- parse' start mlimit input
@@ -240,7 +178,7 @@ cpgfMain qsem command (t,(pgf,pc)) =
morpho (from,concr) input =
showJSON [makeObj ["lemma".=l,"analysis".=a,"prob".=p]|(l,a,p)<-ms]
- where ms = C.lookupMorpho concr input
+ where ms = lookupMorpho concr input
wordforword input@((from,_),_) = jsonWFW from . wordforword' input
@@ -259,7 +197,7 @@ cpgfMain qsem command (t,(pgf,pc)) =
where
lin_word' c = either id (lin1 c)
- lin1 c = dropq . C.linearize c
+ lin1 c = dropq . linearize c
where
dropq (q:' ':s) | q `elem` "+*" = s
dropq s = s
@@ -278,12 +216,12 @@ cpgfMain qsem command (t,(pgf,pc)) =
| isUpper c -> toLower c : cs
s -> s
- parse1 s = case C.parse concr cat s of
- C.ParseOk ((t,_):ts) -> Just t
- _ -> Nothing
+ parse1 s = case PGF2.parse concr cat s of
+ ParseOk ((t,_):ts) -> Just t
+ _ -> Nothing
morph w = listToMaybe
- [t | (f,a,p)<-C.lookupMorpho concr w,
- t<-maybeToList (C.readExpr f)]
+ [t | (f,a,p)<-lookupMorpho concr w,
+ t<-maybeToList (readExpr f)]
---
@@ -303,28 +241,17 @@ cpgfMain qsem command (t,(pgf,pc)) =
getLangs = getLangs' readLang
getLang = getLang' readLang
- readLang :: String -> CGI (String,C.Concr)
+ readLang :: String -> CGI (String,Concr)
readLang lang =
case Map.lookup lang langs of
Nothing -> badRequest "Bad language" lang
Just c -> return (lang,c)
tree = do s <- maybe (missing "tree") return =<< getInput1 "tree"
- let t = C.readExpr s
- maybe (badRequest "bad tree" s) return t
+ maybe (badRequest "bad tree" s) return (readExpr s)
- c_lexer concr = lexer (not . null . C.lookupMorpho concr)
+ c_lexer concr = lexer (not . null . lookupMorpho concr)
---------------------------------------------------------------------------------
-
-
--- | Convert a 'Tree' to an 'ATree'
-cToATree :: C.Expr -> PGF.ATree C.Expr
-cToATree e = maybe (PGF.Other e) app (C.unApp e)
- where
- app (f,es) = PGF.App (read f) (map cToATree es)
-
-#endif
--------------------------------------------------------------------------------
-- * Lexing
@@ -355,7 +282,7 @@ unlexer good = maybe (return id) unlexerfun =<< getInput "unlexer"
--------------------------------------------------------------------------------
-- * Haskell run-time functionality
-
+{-
--pgfMain :: Cache Labels -> FilePath -> String -> PGF -> CGI CGIResult
pgfMain lcs@(alc,clc) path command tpgf@(t,pgf) =
case command of
@@ -464,7 +391,7 @@ pgfMain lcs@(alc,clc) path command tpgf@(t,pgf) =
-- * Request parameter access and related auxiliary functions
---out = outputJSONP
+-}
out t r = do let fmt = formatTime defaultTimeLocale rfc822DateFormat t
setHeader "Last-Modified" fmt
outputJSONP r
@@ -508,7 +435,7 @@ throw code msg extra =
throwCGIError code msg [msg ++(if null extra then "" else ": "++extra)]
format def = maybe def id # getInput "format"
-
+{-
-- * Request implementations
-- Hook for simple extensions of the PGF service
@@ -537,11 +464,11 @@ doLookupMorpho pgf from input =
where
ms = PGF.lookupMorpho (PGF.buildMorpho pgf from) input
-
+-}
type From = (Maybe PGF.Language,String)
type To = ([PGF.Language],Unlexer)
type TreeOpts = (Bool,Bool) -- (trie,jsontree)
-
+{-
doTranslate :: PGF -> From -> Maybe PGF.Type -> To -> Maybe Int -> TreeOpts -> JSValue
doTranslate pgf (mfrom,input) mcat tos mlimit (trie,jsontree) =
showJSON
@@ -633,10 +560,10 @@ doParse pgf (mfrom,input) mcat mlimit (trie,jsontree) = showJSON $ map makeObj
addTrie trie trees =
["trie".=map head (PGF.toTrie (map PGF.toATree trees))|trie]
-
+-}
addTree json tree = "tree".=showTree tree:
["jsontree".= jsonExpr tree | json]
-
+{-
doComplete :: PGF -> From -> Maybe PGF.Type -> Maybe Int -> Bool -> JSValue
doComplete pgf (mfrom,input) mcat mlimit full = showJSON
[makeObj (
@@ -732,7 +659,7 @@ doGrammar (t1,pgf) elbls macc = out t $ showJSON $ makeObj
| l <- PGF.languages pgf]
categories = [PGF.showCId cat | cat <- PGF.categories pgf]
functions = [PGF.showCId fun | fun <- PGF.functions pgf]
-
+-}
outputGraphviz code =
do fmt <- format "png"
case fmt of
@@ -748,7 +675,7 @@ outputGraphviz code =
"svg" -> "image/svg+xml"
-- ...
_ -> "application/binary"
-
+{-
abstrTree pgf opts tree = PGF.graphvizAbstractTree pgf opts' tree
where opts' = (not (PGF.noFun opts),not (PGF.noCat opts))
@@ -789,7 +716,7 @@ tryIO = E.try
alignment pgf tree (tos,unlex) = PGF.graphvizAlignment pgf tos' tree
where tos' = if null tos then PGF.languages pgf else tos
-
+-}
pipeIt2graphviz :: String -> String -> IO BS.ByteString
pipeIt2graphviz fmt code = do
(Just inh, Just outh, _, pid) <-
@@ -821,7 +748,7 @@ pipeIt2graphviz fmt code = do
case ex of
ExitSuccess -> return output
ExitFailure r -> fail ("pipeIt2graphviz: (exit " ++ show r ++ ")")
-
+{-
browse1json pgf id pn = makeObj . maybe [] obj $ PGF.browse pgf id
where
obj (def,ps,cs) = if pn then (baseobj ++ pnames) else baseobj
@@ -921,7 +848,7 @@ doBrowse pgf (Just id) cssClass href _ pn = -- default to "html" format
annotatePrintNames = ""++(unwords pns)++"
"
where pns = [""++(show lang)++""++(PGF.showPrintName pgf lang id)++"" | lang <- PGF.languages pgf ]
-
+-}
class ToATree a where
showTree :: a -> String
toATree :: a -> PGF.ATree a
@@ -961,11 +888,7 @@ instance JSON PGF.Expr where
instance JSON PGF.BracketedString where
readJSON x = return (PGF.Leaf "")
-#ifdef C_RUNTIME
showJSON (PGF.Bracket cat fid index fun bs) =
-#else
- showJSON (PGF.Bracket cat fid index fun _ bs) =
-#endif
makeObj ["cat".=cat, "fid".=fid, "index".=index, "fun".=fun, "children".=bs]
showJSON (PGF.Leaf s) = makeObj ["token".=s]
@@ -1038,3 +961,4 @@ f % x = ap f x
--cleanFilePath :: FilePath -> FilePath
--cleanFilePath = takeFileName
+