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

Merge branch 'master' of https://github.com/GrammaticalFramework/GF

Browse Source
This commit is contained in:
Inari Listenmaa
2017-08-21 10:26:57 +03:00
parent 2d85550e54 0a3b822313
commit c89759e638
9 changed files with 49 additions and 75 deletions
Download Patch File Download Diff File Expand all files Collapse all files

7
WebSetup.hs
View File

@@ -98,14 +98,13 @@ execute command args =
showArg arg = if ' ' `elem` arg then "'" ++ arg ++ "'" else arg
-- | This function is used to enable parallel compilation of the RGL and
-- example grammars, but it is commented out by default
-- to avoid casing problems for developers using Cabal<1.20
-- example grammars
numJobs flags =
if null n
then ["-j","+RTS","-A20M","-N","-RTS"]
else ["-j="++n,"+RTS","-A20M","-N"++n,"-RTS"]
where
-- buildNumJobs is only available in Cabal>=1.20
n = {-case buildNumJobs flags of
n = case buildNumJobs flags of
Flag mn | mn/=Just 1-> maybe "" show mn
_ ->-} ""
_ -> ""

8
gf.cabal
View File

@@ -1,7 +1,7 @@
name: gf
version: 3.9
version: 3.9-git
cabal-version: >= 1.10
cabal-version: >= 1.20
build-type: Custom
license: OtherLicense
license-file: LICENSE
@@ -57,6 +57,7 @@ flag interrupt
flag server
Description: Include --server mode
Default: True
flag network-uri
description: Get Network.URI from the network-uri package
default: True
@@ -68,6 +69,7 @@ flag network-uri
flag custom-binary
Description: Use a customised version of the binary package
Default: True
Manual: True
flag c-runtime
Description: Include functionality from the C run-time library (which must be installed already)
@@ -75,7 +77,7 @@ flag c-runtime
Library
default-language: Haskell2010
build-depends: base >= 4.5 && <5,
build-depends: base >= 4.6 && <5,
array,
containers,
bytestring,

2
index.html
View File

@@ -89,7 +89,7 @@ function sitesearch() {
</ul>
<h4>Develop Applications</h4>
<ul>
<li><a href="http://hackage.haskell.org/package/gf-3.7.1/docs/PGF.html">PGF library API (Haskell)</a>
<li><a href="http://hackage.haskell.org/package/gf-3.9/docs/PGF.html">PGF library API (Haskell)</a>
<li><a href="doc/python-api.html">PGF library API (Python)</a>
<li><a href="doc/java-api/index.html">PGF library API (Java)</a>
<li><a href="doc/dotNet-api/index.html">PGF library API (.NET)</a>

8
src/compiler/GF/System/Catch.hs
View File

@@ -1,13 +1,7 @@
-- | Isolate backwards incompatible library changes to 'catch' and 'try'
{-# LANGUAGE CPP #-}
-- | Backwards compatible 'catch' and 'try'
module GF.System.Catch where
import qualified System.IO.Error as S
-- ** Backwards compatible try and catch
#if MIN_VERSION_base(4,4,0)
catch = S.catchIOError
try = S.tryIOError
#else
catch = S.catch
try = S.try
#endif

10
src/compiler/GF/System/Concurrency.hs
View File

@@ -1,7 +1,6 @@
{-# LANGUAGE CPP,ForeignFunctionInterface #-}
{-# LANGUAGE ForeignFunctionInterface #-}
-- | A variant of 'Control.Concurrent.setNumCapabilities' that automatically
-- detects the number of processors in the system, and is available
-- even when compiling with GHC<7.6.
-- detects the number of processors in the system.
module GF.System.Concurrency(
-- * Controlling parallelism
setNumCapabilities,getNumberOfProcessors) where
@@ -16,13 +15,8 @@ import Foreign.C.Types(CInt(..))
-- hasn't already been set with @+RTS -N/n/ -RTS@.
setNumCapabilities opt_n =
do n <- maybe getNumberOfProcessors return opt_n
#if MIN_VERSION_base(4,6,0)
C.setNumCapabilities n
return True
#else
n_now <- C.getNumCapabilities
return (n==n_now)
#endif
-- | Returns the number of processors in the system.
getNumberOfProcessors = fmap fromEnum c_getNumberOfProcessors

4
src/runtime/c/configure.ac
View File

@@ -1,5 +1,5 @@
AC_INIT(Portable Grammar Format library, 0.1.pre,
https://code.google.com/p/grammatical-framework/,
AC_INIT(Portable Grammar Format library, 0.1-pre,
http://www.grammaticalframework.org/,
libpgf)
AC_PREREQ(2.58)

3
src/runtime/haskell/PGF/Data.hs
View File

@@ -124,11 +124,12 @@ readLanguage = readCId
showLanguage :: Language -> String
showLanguage = showCId
fidString, fidInt, fidFloat, fidVar :: FId
fidString, fidInt, fidFloat, fidVar, fidStart :: FId
fidString = (-1)
fidInt = (-2)
fidFloat = (-3)
fidVar = (-4)
fidStart = (-5)
isPredefFId :: FId -> Bool
isPredefFId = (`elem` [fidString, fidInt, fidFloat, fidVar])

6
src/runtime/haskell/PGF/Optimize.hs
View File

@@ -1,4 +1,4 @@
{-# LANGUAGE CPP, BangPatterns #-}
{-# LANGUAGE BangPatterns #-}
module PGF.Optimize
( optimizePGF
, updateProductionIndices
@@ -11,11 +11,7 @@ import PGF.Macros
import Data.List (mapAccumL)
import Data.Array.IArray
import Data.Array.MArray
#if MIN_VERSION_base(4,6,0)
import Data.Array.Unsafe as U(unsafeFreeze)
#else
import Data.Array.ST as U(unsafeFreeze)
#endif
import Data.Array.ST
import Data.Array.Unboxed
import qualified Data.Map as Map

76
src/runtime/haskell/PGF/Parse.hs
View File

@@ -77,34 +77,27 @@ parseWithRecovery pgf lang typ open_typs dp toks = accept (initState pgf lang ty
Just ps -> accept ps ts
Nothing -> skip ps_map ts
-- | Creates an initial parsing state for a given language and
-- startup category.
initState :: PGF -> Language -> Type -> ParseState
initState pgf lang (DTyp _ start _) =
let (acc,items) = case Map.lookup start (cnccats cnc) of
Just (CncCat s e labels) ->
let keys = do fid <- range (s,e)
lbl <- indices labels
return (AK fid lbl)
in foldl' (\(acc,items) key -> predict flit ftok cnc
(pproductions cnc)
key key 0
acc items)
(Map.empty,[])
keys
Nothing -> (Map.empty,[])
let items = case Map.lookup start (cnccats cnc) of
Just (CncCat s e labels) ->
do fid <- range (s,e)
funid <- fromMaybe [] (IntMap.lookup fid (linrefs cnc))
let lbl = 0
CncFun _ lins = unsafeAt (cncfuns cnc) funid
return (Active 0 0 funid (unsafeAt lins lbl) [PArg [] fid] (AK fidStart lbl))
Nothing -> []
in PState abs
cnc
(Chart emptyAC [] emptyPC (pproductions cnc) (totalCats cnc) 0)
(TrieMap.compose (Just (Set.fromList items)) acc)
(TrieMap.compose (Just (Set.fromList items)) Map.empty)
where
abs = abstract pgf
cnc = lookConcrComplete pgf lang
flit _ = Nothing
ftok = Map.unionWith (TrieMap.unionWith Set.union)
-- | This function constructs the simplest possible parser input.
-- It checks the tokens for exact matching and recognizes only @String@, @Int@ and @Float@ literals.
@@ -218,7 +211,7 @@ recoveryStates open_types (EState abs cnc chart) =
-- limited by the category specified, which is usually
-- the same as the startup category.
getParseOutput :: ParseState -> Type -> Maybe Int -> (ParseOutput,BracketedString)
getParseOutput (PState abs cnc chart cnt) ty@(DTyp _ start _) dp =
getParseOutput (PState abs cnc chart cnt) ty dp =
let froots | null roots = getPartialSeq (sequences cnc) (reverse (active chart1 : actives chart1)) seq
| otherwise = [([SymCat 0 lbl],[PArg [] fid]) | AK fid lbl <- roots]
@@ -253,12 +246,11 @@ getParseOutput (PState abs cnc chart cnt) ty@(DTyp _ start _) dp =
sym -> []
in init ++ tail
roots = case Map.lookup start (cnccats cnc) of
Just (CncCat s e lbls) -> do cat <- range (s,e)
lbl <- indices lbls
fid <- maybeToList (lookupPC (PK cat lbl 0) (passive chart1))
return (AK fid lbl)
Nothing -> mzero
roots = do let lbl = 0
fid <- maybeToList (lookupPC (PK fidStart lbl 0) (passive chart1))
PApply _ [PArg _ fid] <- maybe [] Set.toList (IntMap.lookup fid (forest chart1))
return (AK fid lbl)
getPartialSeq seqs actives = expand Set.empty
where
@@ -400,29 +392,25 @@ process flit ftok cnc (item@(Active j ppos funid seqid args key0):items) acc cha
ftok_ (tok:toks) item cnt =
ftok (Map.singleton tok (TrieMap.singleton toks (Set.singleton item))) cnt
predict flit ftok cnc forest key0 key@(AK fid lbl) k acc items =
let (acc1,items1) = case IntMap.lookup fid forest of
Nothing -> (acc,items)
Just set -> Set.fold foldProd (acc,items) set
predict flit ftok cnc forest key0 key@(AK fid lbl) k acc items =
let (acc1,items1) = case IntMap.lookup fid forest of
Nothing -> (acc,items)
Just set -> Set.fold foldProd (acc,items) set
(acc2,items2) = case IntMap.lookup fid (lexicon cnc) >>= IntMap.lookup lbl of
Just tmap -> let (mb_v,toks) = TrieMap.decompose (TrieMap.map (toItems key0 k) tmap)
acc1' = ftok toks acc1
items1' = maybe [] Set.toList mb_v ++ items1
in (acc1',items1')
Nothing -> (acc1,items1)
in (acc2,items2)
where
foldProd (PCoerce fid) (acc,items) = predict flit ftok cnc forest key0 (AK fid lbl) k acc items
foldProd (PApply funid args) (acc,items) = (acc,Active k 0 funid (rhs funid lbl) args key0 : items)
foldProd (PConst _ const toks) (acc,items) = (acc,items)
rhs funid lbl = unsafeAt lins lbl
(acc2,items2) = case IntMap.lookup fid (lexicon cnc) >>= IntMap.lookup lbl of
Just tmap -> let (mb_v,toks) = TrieMap.decompose (TrieMap.map (toItems key0 k) tmap)
acc1' = ftok toks acc1
items1' = maybe [] Set.toList mb_v ++ items1
in (acc1',items1')
Nothing -> (acc1,items1)
in (acc2,items2)
where
CncFun _ lins = unsafeAt (cncfuns cnc) funid
foldProd (PCoerce fid) (acc,items) = predict flit ftok cnc forest key0 (AK fid lbl) k acc items
foldProd (PApply funid args) (acc,items) = (acc,Active k 0 funid (rhs funid lbl) args key0 : items)
foldProd (PConst _ const toks) (acc,items) = (acc,items)
toItems key@(AK fid lbl) k funids =
Set.fromList [Active k 1 funid (rhs funid lbl) [] key | funid <- IntSet.toList funids]
toItems key@(AK fid lbl) k funids =
Set.fromList [Active k 1 funid (rhs funid lbl) [] key | funid <- IntSet.toList funids]
updateAt :: Int -> a -> [a] -> [a]