diff options
Diffstat (limited to 'src/runtime/haskell')
23 files changed, 184 insertions, 61 deletions
diff --git a/src/runtime/haskell/PGF.hs b/src/runtime/haskell/PGF.hs index fdb834cad..e7e5c53c5 100644 --- a/src/runtime/haskell/PGF.hs +++ b/src/runtime/haskell/PGF.hs @@ -21,6 +21,8 @@ module PGF( -- * Identifiers CId, mkCId, wildCId, showCId, readCId, + -- extra + ppCId, pIdent, bsCId, -- * Languages Language, @@ -50,6 +52,8 @@ module PGF( mkInt, unInt, mkDouble, unDouble, mkMeta, unMeta, + -- extra + pExpr, -- * Operations -- ** Linearization @@ -111,6 +115,8 @@ module PGF( Lemma, Analysis, Morpho, lookupMorpho, buildMorpho, fullFormLexicon, morphoMissing, + -- extra: + morphoKnown, isInMorpho, -- ** Tokenizing mkTokenizer, @@ -124,6 +130,8 @@ module PGF( gizaAlignment, GraphvizOptions(..), graphvizDefaults, + -- extra: + getDepLabels, -- * Probabilities Probabilities, @@ -131,6 +139,8 @@ module PGF( defaultProbabilities, showProbabilities, readProbabilitiesFromFile, + -- extra: + probTree, setProbabilities, rankTreesByProbs, -- -- ** SortTop -- forExample, @@ -153,21 +163,20 @@ import PGF.Macros import PGF.Expr (Tree) import PGF.Morphology import PGF.Data -import PGF.Binary +import PGF.Binary() import PGF.Tokenizer import qualified PGF.Forest as Forest import qualified PGF.Parse as Parse +import PGF.Utilities(replace) -import GF.Data.Utilities (replace) - -import Data.Char +--import Data.Char import qualified Data.Map as Map -import qualified Data.IntMap as IntMap -import Data.Maybe +--import qualified Data.IntMap as IntMap +--import Data.Maybe import Data.Binary import Data.List(mapAccumL) -import System.Random (newStdGen) -import Control.Monad +--import System.Random (newStdGen) +--import Control.Monad import Text.PrettyPrint --------------------------------------------------- diff --git a/src/runtime/haskell/PGF/Binary.hs b/src/runtime/haskell/PGF/Binary.hs index bf8fe2824..202939f04 100644 --- a/src/runtime/haskell/PGF/Binary.hs +++ b/src/runtime/haskell/PGF/Binary.hs @@ -10,7 +10,7 @@ import Data.Array.IArray import qualified Data.ByteString as BS
import qualified Data.Map as Map
import qualified Data.IntMap as IntMap
-import qualified Data.Set as Set
+--import qualified Data.Set as Set
import Control.Monad
pgfMajorVersion, pgfMinorVersion :: Word16
diff --git a/src/runtime/haskell/PGF/CId.hs b/src/runtime/haskell/PGF/CId.hs index fea304d9d..6a20cb4f3 100644 --- a/src/runtime/haskell/PGF/CId.hs +++ b/src/runtime/haskell/PGF/CId.hs @@ -3,7 +3,7 @@ module PGF.CId (CId(..), readCId, showCId, -- utils - pCId, pIdent, ppCId) where + bsCId, pCId, pIdent, ppCId) where import Control.Monad import qualified Data.ByteString.Char8 as BS @@ -23,6 +23,8 @@ wildCId = CId (BS.singleton '_') mkCId :: String -> CId mkCId s = CId (BS.pack s) +bsCId = CId + -- | Reads an identifier from 'String'. The function returns 'Nothing' if the string is not valid identifier. readCId :: String -> Maybe CId readCId s = case [x | (x,cs) <- RP.readP_to_S pCId s, all isSpace cs] of diff --git a/src/runtime/haskell/PGF/Data.hs b/src/runtime/haskell/PGF/Data.hs index 19df9d0ed..e37b243d0 100644 --- a/src/runtime/haskell/PGF/Data.hs +++ b/src/runtime/haskell/PGF/Data.hs @@ -8,11 +8,11 @@ import qualified Data.Map as Map import qualified Data.Set as Set import qualified Data.IntMap as IntMap import qualified Data.IntSet as IntSet -import qualified GF.Data.TrieMap as TMap +import qualified PGF.TrieMap as TMap import qualified Data.ByteString as BS import Data.Array.IArray import Data.Array.Unboxed -import Data.List +--import Data.List -- internal datatypes for PGF diff --git a/src/runtime/haskell/PGF/Expr.hs b/src/runtime/haskell/PGF/Expr.hs index 998819687..01b791847 100644 --- a/src/runtime/haskell/PGF/Expr.hs +++ b/src/runtime/haskell/PGF/Expr.hs @@ -23,7 +23,7 @@ import PGF.CId import PGF.Type
import Data.Char
-import Data.Maybe
+--import Data.Maybe
import Data.List as List
import qualified Data.Map as Map hiding (showTree)
import Control.Monad
diff --git a/src/runtime/haskell/PGF/Forest.hs b/src/runtime/haskell/PGF/Forest.hs index 89ebfb299..8a38948be 100644 --- a/src/runtime/haskell/PGF/Forest.hs +++ b/src/runtime/haskell/PGF/Forest.hs @@ -32,7 +32,7 @@ import qualified Data.IntSet as IntSet import qualified Data.IntMap as IntMap
import Control.Monad
import Control.Monad.State
-import GF.Data.Utilities (nub')
+import PGF.Utilities (nub')
data Forest
= Forest
diff --git a/src/runtime/haskell/PGF/Generate.hs b/src/runtime/haskell/PGF/Generate.hs index ae6abc938..76854bda2 100644 --- a/src/runtime/haskell/PGF/Generate.hs +++ b/src/runtime/haskell/PGF/Generate.hs @@ -8,14 +8,13 @@ module PGF.Generate import PGF.CId import PGF.Data -import PGF.Expr -import PGF.Macros +--import PGF.Macros import PGF.TypeCheck -import PGF.Probabilistic +--import PGF.Probabilistic -import Data.Maybe (fromMaybe) -import qualified Data.Map as Map -import qualified Data.IntMap as IntMap +--import Data.Maybe (fromMaybe) +--import qualified Data.Map as Map +--import qualified Data.IntMap as IntMap import Control.Monad import Control.Monad.Identity import System.Random diff --git a/src/runtime/haskell/PGF/Linearize.hs b/src/runtime/haskell/PGF/Linearize.hs index 1e3aee02e..6ec339bd5 100644 --- a/src/runtime/haskell/PGF/Linearize.hs +++ b/src/runtime/haskell/PGF/Linearize.hs @@ -12,7 +12,7 @@ import PGF.Macros import PGF.Expr import Data.Array.IArray import Data.List -import Control.Monad +--import Control.Monad import qualified Data.Map as Map import qualified Data.IntMap as IntMap import qualified Data.Set as Set diff --git a/src/runtime/haskell/PGF/Macros.hs b/src/runtime/haskell/PGF/Macros.hs index ce0f8866e..830a16674 100644 --- a/src/runtime/haskell/PGF/Macros.hs +++ b/src/runtime/haskell/PGF/Macros.hs @@ -4,11 +4,11 @@ import PGF.CId import PGF.Data import Control.Monad import qualified Data.Map as Map -import qualified Data.Set as Set -import qualified Data.IntMap as IntMap -import qualified Data.IntSet as IntSet +--import qualified Data.Set as Set +--import qualified Data.IntMap as IntMap +--import qualified Data.IntSet as IntSet import qualified Data.Array as Array -import Data.Maybe +--import Data.Maybe import Data.List import Data.Array.IArray import Text.PrettyPrint diff --git a/src/runtime/haskell/PGF/Morphology.hs b/src/runtime/haskell/PGF/Morphology.hs index 894b64dfb..2da6da44e 100644 --- a/src/runtime/haskell/PGF/Morphology.hs +++ b/src/runtime/haskell/PGF/Morphology.hs @@ -11,7 +11,7 @@ import qualified Data.Map as Map import qualified Data.Set as Set import qualified Data.IntMap as IntMap import Data.Array.IArray -import Data.List (intersperse) +--import Data.List (intersperse) import Data.Char (isDigit) ---- -- these 4 definitions depend on the datastructure used diff --git a/src/runtime/haskell/PGF/Optimize.hs b/src/runtime/haskell/PGF/Optimize.hs index f04a8b04c..bfc12e097 100644 --- a/src/runtime/haskell/PGF/Optimize.hs +++ b/src/runtime/haskell/PGF/Optimize.hs @@ -7,7 +7,7 @@ module PGF.Optimize import PGF.CId import PGF.Data import PGF.Macros -import Data.Maybe +--import Data.Maybe import Data.List (mapAccumL) import Data.Array.IArray import Data.Array.MArray @@ -17,7 +17,7 @@ import qualified Data.Map as Map import qualified Data.Set as Set import qualified Data.IntSet as IntSet import qualified Data.IntMap as IntMap -import qualified GF.Data.TrieMap as TrieMap +import qualified PGF.TrieMap as TrieMap import qualified Data.List as List import Control.Monad.ST diff --git a/src/runtime/haskell/PGF/Paraphrase.hs b/src/runtime/haskell/PGF/Paraphrase.hs index 015779ace..57697b8d2 100644 --- a/src/runtime/haskell/PGF/Paraphrase.hs +++ b/src/runtime/haskell/PGF/Paraphrase.hs @@ -15,13 +15,13 @@ module PGF.Paraphrase ( import PGF.Data import PGF.Tree -import PGF.Macros (lookDef,isData) -import PGF.CId +--import PGF.Macros (lookDef,isData) +--import PGF.CId import Data.List (nub,sort,group) import qualified Data.Map as Map -import Debug.Trace ---- +--import Debug.Trace ---- paraphrase :: PGF -> Expr -> [Expr] paraphrase pgf t = nub (paraphraseN 2 pgf t) diff --git a/src/runtime/haskell/PGF/Parse.hs b/src/runtime/haskell/PGF/Parse.hs index e50f8436e..9c69940ef 100644 --- a/src/runtime/haskell/PGF/Parse.hs +++ b/src/runtime/haskell/PGF/Parse.hs @@ -15,15 +15,14 @@ module PGF.Parse import Data.Array.IArray
import Data.Array.Base (unsafeAt)
import Data.List (isPrefixOf, foldl')
-import Data.Maybe (fromMaybe, maybe, maybeToList)
+import Data.Maybe (fromMaybe, maybeToList)
import qualified Data.Map as Map
-import qualified GF.Data.TrieMap as TrieMap
+import qualified PGF.TrieMap as TrieMap
import qualified Data.IntMap as IntMap
import qualified Data.IntSet as IntSet
import qualified Data.Set as Set
import Control.Monad
-import GF.Data.SortedList
import PGF.CId
import PGF.Data
import PGF.Expr(Tree)
diff --git a/src/runtime/haskell/PGF/Printer.hs b/src/runtime/haskell/PGF/Printer.hs index 5d85255d0..66d8530f0 100644 --- a/src/runtime/haskell/PGF/Printer.hs +++ b/src/runtime/haskell/PGF/Printer.hs @@ -2,16 +2,14 @@ module PGF.Printer (ppPGF,ppCat,ppFId,ppFunId,ppSeqId,ppSeq,ppFun) where import PGF.CId import PGF.Data -import PGF.Macros - -import GF.Data.Operations +--import PGF.Macros import qualified Data.Map as Map import qualified Data.Set as Set import qualified Data.IntMap as IntMap import Data.List import Data.Array.IArray -import Data.Array.Unboxed +--import Data.Array.Unboxed import Text.PrettyPrint diff --git a/src/runtime/haskell/PGF/Probabilistic.hs b/src/runtime/haskell/PGF/Probabilistic.hs index c1fd58fc2..7f980254b 100644 --- a/src/runtime/haskell/PGF/Probabilistic.hs +++ b/src/runtime/haskell/PGF/Probabilistic.hs @@ -15,12 +15,10 @@ module PGF.Probabilistic import PGF.CId import PGF.Data import PGF.Macros -import PGF.Type -import PGF.Expr import qualified Data.Map as Map import Data.List (sortBy,partition,nub,mapAccumL) -import Data.Maybe (fromMaybe, fromJust) +import Data.Maybe (fromMaybe) --, fromJust -- | An abstract data structure which represents -- the probabilities for the different functions in a grammar. diff --git a/src/runtime/haskell/PGF/SortTop.hs b/src/runtime/haskell/PGF/SortTop.hs index 42b5d36d0..5bebd89d6 100644 --- a/src/runtime/haskell/PGF/SortTop.hs +++ b/src/runtime/haskell/PGF/SortTop.hs @@ -4,7 +4,6 @@ module PGF.SortTop import PGF.CId import PGF.Data -import PGF.Expr import qualified Data.Map as Map import qualified Data.Set as Set import Data.Maybe diff --git a/src/runtime/haskell/PGF/Tokenizer.hs b/src/runtime/haskell/PGF/Tokenizer.hs index 101b8fb06..ec75853aa 100644 --- a/src/runtime/haskell/PGF/Tokenizer.hs +++ b/src/runtime/haskell/PGF/Tokenizer.hs @@ -9,7 +9,7 @@ module PGF.Tokenizer ( mkTokenizer ) where -import Data.List (intercalate) +--import Data.List (intercalate) --import Test.QuickCheck import FST.TransducerInterface import PGF.Morphology (fullFormLexicon, buildMorpho) diff --git a/src/runtime/haskell/PGF/Tree.hs b/src/runtime/haskell/PGF/Tree.hs index 62680e29e..96b9979f4 100644 --- a/src/runtime/haskell/PGF/Tree.hs +++ b/src/runtime/haskell/PGF/Tree.hs @@ -7,11 +7,11 @@ module PGF.Tree import PGF.CId import PGF.Expr hiding (Tree) -import Data.Char +--import Data.Char import Data.List as List -import Control.Monad -import qualified Text.PrettyPrint as PP -import qualified Text.ParserCombinators.ReadP as RP +--import Control.Monad +--import qualified Text.PrettyPrint as PP +--import qualified Text.ParserCombinators.ReadP as RP -- | The tree is an evaluated expression in the abstract syntax -- of the grammar. The type is especially restricted to not diff --git a/src/runtime/haskell/PGF/TrieMap.hs b/src/runtime/haskell/PGF/TrieMap.hs new file mode 100644 index 000000000..f0383941a --- /dev/null +++ b/src/runtime/haskell/PGF/TrieMap.hs @@ -0,0 +1,99 @@ +module PGF.TrieMap
+ ( TrieMap
+
+ , empty
+ , singleton
+
+ , lookup
+
+ , null
+ , compose
+ , decompose
+
+ , insertWith
+
+ , union, unionWith
+ , unions, unionsWith
+
+ , elems
+ , toList
+ , fromList, fromListWith
+
+ , map
+ , mapWithKey
+ ) where
+
+import Prelude hiding (lookup, null, map)
+import qualified Data.Map as Map
+import Data.List (foldl')
+
+data TrieMap k v = Tr (Maybe v) (Map.Map k (TrieMap k v))
+
+empty = Tr Nothing Map.empty
+
+singleton :: [k] -> a -> TrieMap k a
+singleton [] v = Tr (Just v) Map.empty
+singleton (k:ks) v = Tr Nothing (Map.singleton k (singleton ks v))
+
+lookup :: Ord k => [k] -> TrieMap k a -> Maybe a
+lookup [] (Tr mb_v m) = mb_v
+lookup (k:ks) (Tr mb_v m) = Map.lookup k m >>= lookup ks
+
+null :: TrieMap k v -> Bool
+null (Tr Nothing m) = Map.null m
+null _ = False
+
+compose :: Maybe v -> Map.Map k (TrieMap k v) -> TrieMap k v
+compose mb_v m = Tr mb_v m
+
+decompose :: TrieMap k v -> (Maybe v, Map.Map k (TrieMap k v))
+decompose (Tr mb_v m) = (mb_v,m)
+
+insertWith :: Ord k => (v -> v -> v) -> [k] -> v -> TrieMap k v -> TrieMap k v
+insertWith f [] v0 (Tr mb_v m) = case mb_v of
+ Just v -> Tr (Just (f v0 v)) m
+ Nothing -> Tr (Just v0 ) m
+insertWith f (k:ks) v0 (Tr mb_v m) = case Map.lookup k m of
+ Nothing -> Tr mb_v (Map.insert k (singleton ks v0) m)
+ Just tr -> Tr mb_v (Map.insert k (insertWith f ks v0 tr) m)
+
+union :: Ord k => TrieMap k v -> TrieMap k v -> TrieMap k v
+union = unionWith (\a b -> a)
+
+unionWith :: Ord k => (v -> v -> v) -> TrieMap k v -> TrieMap k v -> TrieMap k v
+unionWith f (Tr mb_v1 m1) (Tr mb_v2 m2) =
+ let mb_v = case (mb_v1,mb_v2) of
+ (Nothing,Nothing) -> Nothing
+ (Just v ,Nothing) -> Just v
+ (Nothing,Just v ) -> Just v
+ (Just v1,Just v2) -> Just (f v1 v2)
+ m = Map.unionWith (unionWith f) m1 m2
+ in Tr mb_v m
+
+unions :: Ord k => [TrieMap k v] -> TrieMap k v
+unions = foldl union empty
+
+unionsWith :: Ord k => (v -> v -> v) -> [TrieMap k v] -> TrieMap k v
+unionsWith f = foldl (unionWith f) empty
+
+elems :: TrieMap k v -> [v]
+elems tr = collect tr []
+ where
+ collect (Tr mb_v m) xs = maybe id (:) mb_v (Map.fold collect xs m)
+
+toList :: TrieMap k v -> [([k],v)]
+toList tr = collect [] tr []
+ where
+ collect ks (Tr mb_v m) xs = maybe id (\v -> (:) (ks,v)) mb_v (Map.foldWithKey (\k -> collect (k:ks)) xs m)
+
+fromListWith :: Ord k => (v -> v -> v) -> [([k],v)] -> TrieMap k v
+fromListWith f xs = foldl' (\trie (ks,v) -> insertWith f ks v trie) empty xs
+
+fromList :: Ord k => [([k],v)] -> TrieMap k v
+fromList xs = fromListWith const xs
+
+map :: (a -> b) -> TrieMap k a -> TrieMap k b
+map f (Tr mb_v m) = Tr (fmap f mb_v) (Map.map (map f) m)
+
+mapWithKey :: ([k] -> a -> b) -> TrieMap k a -> TrieMap k b
+mapWithKey f (Tr mb_v m) = Tr (fmap (f []) mb_v) (Map.mapWithKey (\k -> mapWithKey (f . (k:))) m)
diff --git a/src/runtime/haskell/PGF/Type.hs b/src/runtime/haskell/PGF/Type.hs index 7114dda79..1d6884a7c 100644 --- a/src/runtime/haskell/PGF/Type.hs +++ b/src/runtime/haskell/PGF/Type.hs @@ -1,4 +1,4 @@ -module PGF.Type ( Type(..), Hypo,
+module PGF.Type ( Type(..), Hypo, CId,
readType, showType,
mkType, mkHypo, mkDepHypo, mkImplHypo,
unType,
@@ -10,7 +10,7 @@ import Data.Char import Data.List
import qualified Text.PrettyPrint as PP
import qualified Text.ParserCombinators.ReadP as RP
-import Control.Monad
+--import Control.Monad
-- | To read a type from a 'String', use 'readType'.
data Type =
diff --git a/src/runtime/haskell/PGF/TypeCheck.hs b/src/runtime/haskell/PGF/TypeCheck.hs index 268742b94..141189193 100644 --- a/src/runtime/haskell/PGF/TypeCheck.hs +++ b/src/runtime/haskell/PGF/TypeCheck.hs @@ -30,7 +30,7 @@ module PGF.TypeCheck ( checkType, checkExpr, inferExpr import PGF.Data import PGF.Expr hiding (eval, apply, applyValue, value2expr) import qualified PGF.Expr as Expr -import PGF.Macros (typeOfHypo, cidInt, cidFloat, cidString) +import PGF.Macros (cidInt, cidFloat, cidString) -- typeOfHypo import PGF.CId import Data.Map as Map @@ -38,7 +38,7 @@ import Data.IntMap as IntMap import Data.Maybe as Maybe import Data.List as List import Control.Monad -import Control.Monad.Identity +--import Control.Monad.Identity import Control.Monad.State import Control.Monad.Error import Text.PrettyPrint diff --git a/src/runtime/haskell/PGF/Utilities.hs b/src/runtime/haskell/PGF/Utilities.hs new file mode 100644 index 000000000..5af5b9b5d --- /dev/null +++ b/src/runtime/haskell/PGF/Utilities.hs @@ -0,0 +1,20 @@ +-- | Basic utilities +module PGF.Utilities where +import Data.Set(empty,member,insert) + + +-- | Like 'nub', but O(n log n) instead of O(n^2), since it uses a set to lookup previous things. +-- The result list is stable (the elements are returned in the order they occur), and lazy. +-- Requires that the list elements can be compared by Ord. +-- Code ruthlessly taken from http://hpaste.org/54411 +nub' :: Ord a => [a] -> [a] +nub' = loop empty + where loop _ [] = [] + loop seen (x : xs) + | member x seen = loop seen xs + | otherwise = x : loop (insert x seen) xs + + +-- | Replace all occurences of an element by another element. +replace :: Eq a => a -> a -> [a] -> [a] +replace x y = map (\z -> if z == x then y else z) diff --git a/src/runtime/haskell/PGF/VisualizeTree.hs b/src/runtime/haskell/PGF/VisualizeTree.hs index ed028feb8..855e40d75 100644 --- a/src/runtime/haskell/PGF/VisualizeTree.hs +++ b/src/runtime/haskell/PGF/VisualizeTree.hs @@ -21,24 +21,24 @@ module PGF.VisualizeTree , getDepLabels ) where -import PGF.CId (CId,wildCId,showCId,ppCId,pCId,mkCId) +import PGF.CId (wildCId,showCId,ppCId,mkCId) --CId,pCId, import PGF.Data -import PGF.Expr (showExpr, Tree) +import PGF.Expr (Tree) -- showExpr import PGF.Linearize -import PGF.Macros (lookValCat, lookMap, - BracketedString(..), BracketedTokn(..), flattenBracketedString) +import PGF.Macros (lookValCat, BracketedString(..)) + --lookMap, BracketedTokn(..), flattenBracketedString import qualified Data.Map as Map -import qualified Data.IntMap as IntMap +--import qualified Data.IntMap as IntMap import Data.List (intersperse,nub,mapAccumL,find) -import Data.Char (isDigit) +--import Data.Char (isDigit) import Data.Maybe (fromMaybe) import Text.PrettyPrint -import Data.Array.IArray -import Control.Monad -import qualified Data.Set as Set -import qualified Text.ParserCombinators.ReadP as RP +--import Data.Array.IArray +--import Control.Monad +--import qualified Data.Set as Set +--import qualified Text.ParserCombinators.ReadP as RP data GraphvizOptions = GraphvizOptions {noLeaves :: Bool, |