From c642421fa97201769aac10e4c053db22537fa9c1 Mon Sep 17 00:00:00 2001 From: Thomas Hallgren Date: Thu, 17 Aug 2017 11:58:23 +0200 Subject: 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(-) (limited to 'src/runtime') 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) -- cgit v1.2.3 From 0a0eaa01bcbe9574bb86a6470ca5139fbd32a9d3 Mon Sep 17 00:00:00 2001 From: Thomas Hallgren Date: Fri, 18 Aug 2017 11:55:44 +0200 Subject: 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(-) (limited to 'src/runtime') 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 -- cgit v1.2.3 From 1f3c9d0b1736daa979e195bc07d971421768e4ad Mon Sep 17 00:00:00 2001 From: Krasimir Angelov Date: Fri, 18 Aug 2017 21:23:58 +0200 Subject: 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 | 78 +++++++++++++++++----------------------- 2 files changed, 35 insertions(+), 46 deletions(-) (limited to 'src/runtime') 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 - - (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 + 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 - 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] -- cgit v1.2.3