From c642421fa97201769aac10e4c053db22537fa9c1 Mon Sep 17 00:00:00 2001
From: Thomas Hallgren <th-github@altocumulus.org>
Date: Thu, 17 Aug 2017 11:58:23 +0200
Subject: [PATCH 1/4] configure.ac: use a Cabal-friendly version number and
 replace the outdated URL

---
 src/runtime/c/configure.ac | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

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)
 

From 1318a62da0fd0022969520ce55e9523394aaa1c5 Mon Sep 17 00:00:00 2001
From: Thomas Hallgren <th-github@altocumulus.org>
Date: Fri, 18 Aug 2017 11:54:13 +0200
Subject: [PATCH 2/4] Home page: update link to PGF library API (Haskell) to
 point to gf-3.9 in Hackage.

---
 index.html | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/index.html b/index.html
index 824dfe23a..d38227c1a 100644
--- a/index.html
+++ b/index.html
@@ -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>

From 0a0eaa01bcbe9574bb86a6470ca5139fbd32a9d3 Mon Sep 17 00:00:00 2001
From: Thomas Hallgren <th-github@altocumulus.org>
Date: Fri, 18 Aug 2017 11:55:44 +0200
Subject: [PATCH 3/4] Bump version requirements to base>=4.6, Cabal>=1.20
 Cabal>=1.20 allows control over parallelism when compiling grammars from
 Setup.hs and WebSetup.hs.

base>=4.6 allows conditional compilation with CPP to be eliminated from
a few modules.

base-4.6 corresponds to GHC 7.6.3, which is what you get in
Debian 8 (aka jessie, aka oldstable) from 2015.
---
 WebSetup.hs                           |  7 +++----
 gf.cabal                              |  8 +++++---
 src/compiler/GF/System/Catch.hs       |  8 +-------
 src/compiler/GF/System/Concurrency.hs | 10 ++--------
 src/runtime/haskell/PGF/Optimize.hs   |  6 +-----
 5 files changed, 12 insertions(+), 27 deletions(-)

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/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/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

From 1f3c9d0b1736daa979e195bc07d971421768e4ad Mon Sep 17 00:00:00 2001
From: Krasimir Angelov <kr.angelov@gmail.com>
Date: Fri, 18 Aug 2017 21:23:58 +0200
Subject: [PATCH 4/4] the parser is not forced to respect the linref while
 parsing discontious phrases

---
 src/runtime/haskell/PGF/Data.hs  |  3 +-
 src/runtime/haskell/PGF/Parse.hs | 76 ++++++++++++++------------------
 2 files changed, 34 insertions(+), 45 deletions(-)

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/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]