summaryrefslogtreecommitdiff
path: root/src/GF/OldParsing/ConvertSimpleToMCFG/Strict.hs
diff options
context:
space:
mode:
authoraarne <aarne@cs.chalmers.se>2008-06-25 16:43:48 +0000
committeraarne <aarne@cs.chalmers.se>2008-06-25 16:43:48 +0000
commitb96b36f43de3e2f8b58d5f539daa6f6d47f25870 (patch)
tree0992334be13cec6538a1dea22fbbf26ad6bdf224 /src/GF/OldParsing/ConvertSimpleToMCFG/Strict.hs
parentfe367412e0aeb4ad5c02de68e6eca382e0f96984 (diff)
removed src for 2.9
Diffstat (limited to 'src/GF/OldParsing/ConvertSimpleToMCFG/Strict.hs')
-rw-r--r--src/GF/OldParsing/ConvertSimpleToMCFG/Strict.hs139
1 files changed, 0 insertions, 139 deletions
diff --git a/src/GF/OldParsing/ConvertSimpleToMCFG/Strict.hs b/src/GF/OldParsing/ConvertSimpleToMCFG/Strict.hs
deleted file mode 100644
index aa741518a..000000000
--- a/src/GF/OldParsing/ConvertSimpleToMCFG/Strict.hs
+++ /dev/null
@@ -1,139 +0,0 @@
-----------------------------------------------------------------------
--- |
--- Maintainer : PL
--- Stability : (stable)
--- Portability : (portable)
---
--- > CVS $Date: 2005/04/21 16:23:00 $
--- > CVS $Author: bringert $
--- > CVS $Revision: 1.2 $
---
--- Converting SimpleGFC grammars to MCFG grammars, deterministic.
---
--- the resulting grammars might be /very large/
---
--- the conversion is only equivalent if the GFC grammar has a context-free backbone.
------------------------------------------------------------------------------
-
-
-module GF.OldParsing.ConvertSimpleToMCFG.Strict (convertGrammar) where
-
-import GF.System.Tracing
-import GF.Infra.Print
-
-import Control.Monad
-
-import GF.Formalism.Utilities
-import GF.Formalism.GCFG
-import GF.Formalism.MCFG
-import GF.Formalism.SimpleGFC
-import GF.Conversion.Types
-
-import GF.Data.BacktrackM
-
-{-
-import GF.Infra.Ident (Ident(..))
-import GF.Canon.AbsGFC
-import GF.Canon.GFC
-import GF.Canon.Look
-import GF.Data.Operations
-import qualified GF.Infra.Modules as M
-import GF.Canon.CMacros (defLinType)
-import GF.Canon.MkGFC (grammar2canon)
-import GF.OldParsing.Utilities
-import GF.OldParsing.GrammarTypes
-import GF.OldParsing.MCFGrammar (Grammar, Rule(..), Lin(..))
-import GF.Data.SortedList
--- import Maybe (listToMaybe)
-import Data.List (groupBy) -- , transpose)
-
-import GF.Data.BacktrackM
--}
-
-----------------------------------------------------------------------
-
-convertGrammar :: SimpleGrammar -> MGrammar
-convertGrammar rules = tracePrt "#mcf-rules total" (prt . length) $
- solutions conversion undefined
- where conversion = member rules >>= convertRule
-
-convertRule :: SimpleRule -> CnvMonad MRule
-convertRule (Rule (Abs decl decls fun) (Cnc ctype ctypes (Just term)))
- = do let cat : args = map decl2cat (decl : decls)
- args_ctypes = zip3 [0..] args ctypes
- instArgs <- mapM enumerateArg args_ctypes
- let instTerm = substitutePaths instArgs term
- newCat <- extractMCat cat ctype instTerm
- newArgs <- mapM (extractArg instArgs) args
- let newLinRec = strPaths ctype instTerm >>= extractLin newArgs
- lintype : lintypes = map (convertLinType emptyPath) (ctype : ctypes)
- return $ Rule (Abs newCat newArgs fun) (Cnc lintype lintypes newLinRec)
-convertRule _ = failure
-
-----------------------------------------------------------------------
-
-type CnvMonad a = BacktrackM () a
-
-----------------------------------------------------------------------
--- strict conversion
-
---extractArg :: [Term] -> (Int, Cat, LinType) -> CnvMonad MCat
-extractArg args (nr, cat, ctype) = emcfCat cat ctype (args !! nr)
-
---emcfCat :: Cat -> LinType -> Term -> CnvMonad MCat
-extractMCat cat ctype term = map (MCat cat) $ parPaths ctype term
-
---enumerateArg :: (Int, Cat, LinType) -> CnvMonad Term
-enumerateArg (nr, cat, ctype) = enumerateTerms (Arg nr cat emptyPath) ctype
-
--- Substitute each instantiated parameter path for its instantiation
-substitutePaths :: [Term] -> Term -> Term
-substitutePaths arguments = subst
- where subst (Arg nr _ path) = followPath path (arguments !! nr)
- subst (con :^ terms) = con :^ map subst terms
- subst (Rec record) = Rec [ (lbl, subst term) | (lbl, term) <- record ]
- subst (term :. lbl) = subst term +. lbl
- subst (Tbl table) = Tbl [ (pat, subst term) |
- (pat, term) <- table ]
- subst (term :! select) = subst term +! subst select
- subst (term :++ term') = subst term ?++ subst term'
- subst (Variants terms) = Variants $ map subst terms
- subst term = term
-
-
---termPaths :: CType -> STerm -> [(Path, (CType, STerm))]
-termPaths ctype (Variants terms) = terms >>= termPaths ctype
-termPaths (StrT) term = [ (emptyPath, (StrT, term)) ]
-termPaths (RecT rtype) (Rec record)
- = [ (path ++. lbl, value) |
- (lbl, term) <- record,
- let Just ctype = lookup lbl rtype,
- (path, value) <- termPaths ctype term ]
-termPaths (TblT _ ctype) (Tbl table)
- = [ (path ++! pat, value) |
- (pat, term) <- table,
- (path, value) <- termPaths ctype term ]
-termPaths (ConT pc _) term = [ (emptyPath, (ConT pc, term)) ]
-
-{- ^^^ variants are pushed inside (not equivalent -- but see record-variants.txt):
-{a=a1; b=b1} | {a=a2; b=b2} ==> {a=a1|a2; b=b1|b2}
-[p=>p1;q=>q1] | [p=>p2;q=>q2] ==> [p=>p1|p2;q=>q1|q2]
--}
-
---parPaths :: CType -> STerm -> [[(Path, STerm)]]
-parPaths ctype term = mapM (uncurry (map . (,))) $ groupPairs $
- nubsort [ (path, value) |
- (path, (ConT _, value)) <- termPaths ctype term ]
-
---strPaths :: CType -> STerm -> [(Path, STerm)]
-strPaths ctype term = [ (path, variants values) | (path, values) <- groupPairs paths ]
- where paths = nubsort [ (path, value) | (path, (StrT, value)) <- termPaths ctype term ]
-
---extractLin :: [MCFCat] -> (Path, STerm) -> [Lin MCFCat MCFLabel Tokn]
-extractLin args (path, term) = map (Lin path) (convertLin term)
- where convertLin (t1 :++ t2) = liftM2 (++) (convertLin t1) (convertLin t2)
- convertLin (Empty) = [[]]
- convertLin (Token tok) = [[Tok tok]]
- convertLin (Variants terms) = concatMap convertLin terms
- convertLin (Arg nr _ path) = [[Cat (args !! nr, path, nr)]]
-