FormalGrammars 0.2.1.1 → 0.3.0.0
raw patch · 5 files changed
+51/−41 lines, 5 filesdep ~ADPfusiondep ~semigroupsPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: ADPfusion, semigroups
API changes (from Hackage documentation)
Files
- FormalGrammars.cabal +8/−7
- FormalLanguage/CFG/TH.hs +22/−22
- changelog.md +10/−0
- src/NeedlemanWunsch.hs +7/−7
- src/Nussinov.hs +4/−5
FormalGrammars.cabal view
@@ -1,7 +1,7 @@ name: FormalGrammars-version: 0.2.1.1-author: Christian Hoener zu Siederdissen, 2013-2015-copyright: Christian Hoener zu Siederdissen, 2013-2015+version: 0.3.0.0+author: Christian Hoener zu Siederdissen, 2013-2016+copyright: Christian Hoener zu Siederdissen, 2013-2016 homepage: https://github.com/choener/FormalGrammars bug-reports: https://github.com/choener/FormalGrammars/issues maintainer: choener@bioinf.uni-leipzig.de@@ -11,7 +11,7 @@ build-type: Simple stability: experimental cabal-version: >= 1.10.0-tested-with: GHC == 7.8.4, GHC == 7.10.2+tested-with: GHC == 7.8.4, GHC == 7.10.3 synopsis: (Context-free) grammars in formal language theory description: <http://www.bioinf.uni-leipzig.de/Software/gADP/ generalized Algebraic Dynamic Programming>@@ -69,7 +69,7 @@ library build-depends: base >= 4.7 && < 4.9- , ADPfusion >= 0.4.1 && < 0.5.1+ , ADPfusion >= 0.5.1 && < 0.5.2 , ansi-wl-pprint >= 0.6.7 && < 0.6.8 , bytestring >= 0.10 && < 0.11 , containers@@ -79,7 +79,7 @@ , mtl >= 2.0 && < 3.0 , parsers >= 0.12 && < 0.13 , PrimitiveArray >= 0.6.0 && < 0.7.1- , semigroups >= 0.16 && < 0.17+ , semigroups >= 0.16 && < 0.19 , template-haskell , text >= 1.0 && < 1.3 , transformers >= 0.3 && < 0.5@@ -103,7 +103,8 @@ FormalLanguage.CFG.TH default-language: Haskell2010- default-extensions: DeriveDataTypeable+ default-extensions: BangPatterns+ , DeriveDataTypeable , DataKinds , FlexibleContexts , FlexibleInstances
FormalLanguage/CFG/TH.hs view
@@ -78,7 +78,7 @@ , _qFullSyntVarNames :: M.Map Symbol Name -- ^ type variable names for the fully applied grammar body / where part -- everything on terminals , _qTermAtomVarNames :: M.Map (String,Int) Name -- ^ (Term-id,Dimension) to var name- , _qTermAtomTyNames :: M.Map String Name -- ^ the type name for each unique terminal symbol (that is: the scalar terminals in each dimension)+ , _qTermAtomTyNames :: M.Map (String,Int) Name -- ^ the type name for each unique terminal symbol (that is: the scalar terminals in each dimension) , _qTermSymbExp :: M.Map Symbol (Type,Exp) -- ^ associate a terminal @Symb@ with a complete @Type@ and @Exp@ , _qPrefix :: String -- ^ prefix for attribute functions }@@ -123,7 +123,7 @@ _qMTyName <- newName "m" _qElemTyName <- newName "s" _qRetTyName <- newName "r"- _qTermAtomTyNames <- M.fromList <$> (mapM (\t -> (t,) <$> newName ("t_" ++ t)) $ g^..termvars.folded.name.getSteName)+ _qTermAtomTyNames <- M.fromList <$> (mapM (\(name,tape) -> ((name,tape),) <$> newNameTerm "t" name tape) $ terminalsWithTape g) -- g^..termvars.folded.name.getSteName) _qPartialSyntVarNames <- M.fromList <$> (mapM (\n -> (n,) <$> newName ("s_" ++ (n^..getSymbolList.folded.name.getSteName.folded))) $ uniqueSyntacticSymbols g) _qInsideSyntVarNames <- M.fromList <$> (mapM (\n -> (n,) <$> newName ("i_" ++ (n^..getSymbolList.folded.name.getSteName.folded))) $ uniqueSynTermSymbols g) let _qPrefix = over _head toLower $ take prefixLen (g^.grammarName)@@ -307,16 +307,14 @@ elemTyName <- use qElemTyName synNames <- use qFullSyntVarNames -- just the name of the fully applied symbol g <- use qGrammar- let genType :: [SynTermEps] -> TypeQ- genType z--- | Symb Outside _ <- z = error $ printf "terminal symbol %s with OUTSIDE annotation!\n" (show z)+ let genType :: Int -> [SynTermEps] -> TypeQ+ genType tape z | [Deletion] <- z = [t| () |] | [Epsilon ] <- z = [t| () |] | [Term tnm tidx] <- z- , Just v <- M.lookup (tnm^.getSteName) ttypes = varT v- | [Term tnm tidx] <- z- {- , Just v <- M.lookup (tnm^.getSteName) (error "bla") -} = varT elemTyName- | xs <- z = foldl (\acc z -> [t| $acc :. $(genType [z]) |]) [t| Z |] xs+ , Just v <- M.lookup (tnm^.getSteName,tape) ttypes = varT v -- single dimension only, set dim to 0+ | [Term tnm tidx] <- z = varT elemTyName+ | xs <- z = foldl (\acc (tape',z) -> [t| $acc :. $(genType tape' [z]) |]) [t| Z |] (zip [0..] xs) let genSingleExp :: Int -> SynTermEps -> ExpQ genSingleExp _ Deletion = [| ADP.Deletion |] genSingleExp _ Epsilon = [| ADP.Epsilon |]@@ -325,28 +323,29 @@ | Just n <- M.lookup (tnm^.getSteName,k) tavn = varE n -- TODO this one is dangerous but currently necessary for split -- systems- | Just n <- M.lookup (tnm^.getSteName,0) tavn = varE n+ | Just n <- M.lookup (tnm^.getSteName,k) tavn = varE n | otherwise = error $ show ("genSingleExp:Term: ",k,tnm,tidx, tavn) genSingleExp _ err = error $ "genSingleExp: " ++ show (s,err) let genExp :: [SynTermEps] -> ExpQ genExp z--- | Symb Outside _ <- z = error $ printf "terminal symbol %s with OUTSIDE annotation!\n" (show z) | [Deletion] <- z = [| ADP.Deletion |] -- TODO ??? | [Epsilon ] <- z = [| ADP.Epsilon |] | [Term tnm tidx] <- z , Just v <- M.lookup (tnm^.getSteName,0) tavn = varE v | xs <- z = foldl (\acc (k,z) -> [| $acc ADP.:| $(genSingleExp k z) |]) [| ADP.M |] $ zip [0..] xs-{- - | xs <- z = foldl (\acc (k,z) -> [| $acc ADP.:| $(case z of { Deletion -> [| ADP.Deletion |]- ; Epsilon -> [| ADP.Epsilon |]- ; Term tnm tidx -> varE $ M.findWithDefault (error $ "genExp: " ++ show (tnm^.getSteName,k)) (tnm^.getSteName,k) tavn- }) |])- [| ADP.M |] $ zip [0..] xs -}- ty <- lift . genType $ s^.getSymbolList+ ty <- lift . genType 0 $ s^.getSymbolList ex <- lift . genExp $ s^.getSymbolList return (s, (ty,ex)) +-- | Given a grammar, gives us each terminal on each tape.++terminalsWithTape :: Grammar -> [(String,Int)]+terminalsWithTape = map go . filter isTerm . uniqueTermsWithTape -- uniqueBindableTermsWithTape+ where go (t,d) = (t^.name.getSteName,d^.getTape)+ isTerm (Term{},_) = True+ isTerm _ = False+ -- | Each terminal symbol is bound to some input. Since we might have the -- same name in different dimensions, we now explicitly annotate with -- a dimensional index. This means that each atomic terminal is annotated@@ -355,11 +354,12 @@ dimensionalTermSymbNames :: TQ [((String,Int),Name)] dimensionalTermSymbNames = do g <- use qGrammar- ys <- forM (uniqueBindableTermsWithTape g) $ \(t,d) -> do- let sn = t^.name.getSteName- let dm = d^.getTape- ( (sn,dm) , ) <$> (lift $ newName $ "term" ++ sn ++ show dm)+ ys <- forM (terminalsWithTape g) $ \(name,tape) -> do+ ( (name,tape) , ) <$> (lift $ newNameTerm "term" name tape) return ys++--newNameTerm :: String -> Int -> TQ Name+newNameTerm prefix name tape = newName $ prefix ++ "_" ++ name ++ "_" ++ show tape ++ "_" -- | Build the full grammar. Generate a name (the grammar name prefixed -- with a @"g"@), the arguments, and the body of the grammar.
changelog.md view
@@ -1,3 +1,13 @@+0.3.0.0+-------++- Major change in terminal symbol handling: In 0.2.x.y versions, when you named+ a terminal (say 'c') then each occurance of 'c' had the same type. This was+ *independent* of the tape the symbol occured on. Starting with 0.3.0.0 if you+ have a terminal with the same name on different tapes, then you will have to+ give each type explicitly. This requires a bit more typing for homogenous+ grammars, but makes heterogenous multi-tape grammars much more flexible.+ 0.2.1.0 -------
src/NeedlemanWunsch.hs view
@@ -12,7 +12,6 @@ import Language.Haskell.TH import Language.Haskell.TH.Syntax import qualified Data.Vector.Fusion.Stream.Monadic as SM-import qualified Data.Vector.Fusion.Stream as S import qualified Data.Vector.Unboxed as VU import Data.Vector.Unboxed (Vector) import Text.Printf@@ -31,13 +30,12 @@ Grammar: Global N: X-T: l-T: u+T: c -- NOTE that each tape with a 'c' uses its own type! S: [X,X] [X,X] -> done <<< [e,e]-[X,X] -> align <<< [X,X] [l,u]-[X,X] -> indel <<< [X,X] [-,u]-[X,X] -> delin <<< [X,X] [l,-]+[X,X] -> align <<< [X,X] [c,c]+[X,X] -> indel <<< [X,X] [-,c]+[X,X] -> delin <<< [X,X] [c,-] // Emit: Global@@ -46,6 +44,7 @@ makeAlgebraProduct ''SigGlobal + -- | score :: Monad m => SigGlobal m Int Int Char Char@@ -58,6 +57,7 @@ } {-# INLINE score #-} + -- | -- -- NOTE The alignment needs to be reversed to print out.@@ -83,7 +83,7 @@ -- | Decoupling the forward phase for CORE observation. -runNeedlemanWunschForward :: Vector Char -> Vector Char -> Z:.(ITbl Id Unboxed (Z:.PointL:.PointL) Int)+runNeedlemanWunschForward :: Vector Char -> Vector Char -> Z:.(ITbl Id Unboxed (Z:.PointL I:.PointL I) Int) runNeedlemanWunschForward i1 i2 = let n1 = VU.length i1; n2 = VU.length i2 in mutateTablesDefault $ gGlobal score (ITbl 0 0 (Z:.EmptyOk:.EmptyOk) (PA.fromAssocs (Z:.PointL 0:.PointL 0) (Z:.PointL n1:.PointL n2) (-999999) []))
src/Nussinov.hs view
@@ -11,7 +11,6 @@ import Data.Vector.Fusion.Util import Language.Haskell.TH import Language.Haskell.TH.Syntax-import qualified Data.Vector.Fusion.Stream as S import qualified Data.Vector.Fusion.Stream.Monadic as SM import qualified Data.Vector.Unboxed as VU import Text.Printf@@ -92,7 +91,7 @@ $ gNussinov bpmax (ITbl 0 0 EmptyOk (PA.fromAssocs (subword 0 0) (subword 0 n) (-999999) [])) (chr i)- :: Z:.ITbl Id Unboxed Subword Int+ :: Z:.ITbl Id Unboxed (Subword I) Int d = unId $ axiom t !(Z:.b) = gNussinov (bpmax <|| pretty) (toBacktrack t (undefined :: Id a -> Id a)) (chr i) {-# NoInline runNussinov #-}@@ -103,10 +102,10 @@ n = VU.length i !(Z:.t) = mutateTablesDefault $ gVonissun bpmaxV- (ITbl 0 0 EmptyOk (PA.fromAssocs (O $ subword 0 0) (O $ subword 0 n) (-999999) []))- (undefined :: ITbl Id Unboxed Subword Int)+ (ITbl 0 0 EmptyOk (PA.fromAssocs (subword 0 0) (subword 0 n) (-999999) []))+ (undefined :: ITbl Id Unboxed (Subword O) Int) (chr i)- :: Z:.ITbl Id Unboxed (Outside Subword) Int+ :: Z:.ITbl Id Unboxed (Subword O) Int d = unId $ axiom t -- !(Z:.b) = gVonissun (bpmaxV <|| prettyV) (toBacktrack t (undefined :: Id a -> Id a)) (undefined :: Backtrack (ITbl Id Unboxed Subword Int) Id Id String) (chr i) {-# NoInline runVonissun #-}