diff --git a/WebSetup.hs b/WebSetup.hs
index 3e2e0832d..ee9f741d6 100644
--- a/WebSetup.hs
+++ b/WebSetup.hs
@@ -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
- _ ->-} ""
+ _ -> ""
diff --git a/gf.cabal b/gf.cabal
index 38dc6ddb9..120b11b2f 100644
--- a/gf.cabal
+++ b/gf.cabal
@@ -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,
diff --git a/index.html b/index.html
index 824dfe23a..d38227c1a 100644
--- a/index.html
+++ b/index.html
@@ -89,7 +89,7 @@ function sitesearch() {
Develop Applications
- - PGF library API (Haskell)
+
- PGF library API (Haskell)
- PGF library API (Python)
- PGF library API (Java)
- PGF library API (.NET)
diff --git a/src/compiler/GF/System/Catch.hs b/src/compiler/GF/System/Catch.hs
index f69934af5..11fae1a7b 100644
--- a/src/compiler/GF/System/Catch.hs
+++ b/src/compiler/GF/System/Catch.hs
@@ -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
diff --git a/src/compiler/GF/System/Concurrency.hs b/src/compiler/GF/System/Concurrency.hs
index 41f318c7a..514eab649 100644
--- a/src/compiler/GF/System/Concurrency.hs
+++ b/src/compiler/GF/System/Concurrency.hs
@@ -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
diff --git a/src/runtime/c/configure.ac b/src/runtime/c/configure.ac
index 2af9016de..f52479a5b 100644
--- a/src/runtime/c/configure.ac
+++ b/src/runtime/c/configure.ac
@@ -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)
diff --git a/src/runtime/haskell/PGF/Data.hs b/src/runtime/haskell/PGF/Data.hs
index bd818ea1b..6a0714faf 100644
--- a/src/runtime/haskell/PGF/Data.hs
+++ b/src/runtime/haskell/PGF/Data.hs
@@ -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])
diff --git a/src/runtime/haskell/PGF/Optimize.hs b/src/runtime/haskell/PGF/Optimize.hs
index 45b4311a5..8739c8665 100644
--- a/src/runtime/haskell/PGF/Optimize.hs
+++ b/src/runtime/haskell/PGF/Optimize.hs
@@ -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
diff --git a/src/runtime/haskell/PGF/Parse.hs b/src/runtime/haskell/PGF/Parse.hs
index 0b435fc28..322385a84 100644
--- a/src/runtime/haskell/PGF/Parse.hs
+++ b/src/runtime/haskell/PGF/Parse.hs
@@ -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]