removed src for 2.9

1 files changed, 0 insertions, 245 deletions

diff --git a/src/GF/OldParsing/ConvertSimpleToMCFG/Nondet.hs b/src/GF/OldParsing/ConvertSimpleToMCFG/Nondet.hs
deleted file mode 100644
index 6627c5f2e..000000000
--- a/src/GF/OldParsing/ConvertSimpleToMCFG/Nondet.hs
+++ /dev/null
@@ -1,245 +0,0 @@
-----------------------------------------------------------------------
--- |
--- Maintainer  : PL
--- Stability   : (stable)
--- Portability : (portable)
---
--- > CVS $Date: 2005/04/21 16:22:58 $ 
--- > CVS $Author: bringert $
--- > CVS $Revision: 1.2 $
---
--- Converting SimpleGFC grammars to MCFG grammars, nondeterministically.
---
--- 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.Nondet (convertGrammar) where
-
-import GF.System.Tracing
-import GF.Printing.PrintParser
-import GF.Printing.PrintSimplifiedTerm
--- import PrintGFC
--- import qualified PrGrammar as PG
-
-import Control.Monad
--- import Ident (Ident(..))
-import qualified GF.Canon.AbsGFC as AbsGFC
--- import GFC
-import GF.Canon.Look
-import GF.Data.Operations
--- import qualified Modules as M
-import GF.Canon.CMacros (defLinType)
--- import MkGFC (grammar2canon)
-import GF.OldParsing.Utilities
--- import GF.OldParsing.GrammarTypes 
-import GF.Data.SortedList
-import qualified GF.OldParsing.MCFGrammar as MCF (Grammar, Rule(..), Lin(..)) 
-import GF.OldParsing.SimpleGFC 
--- import Maybe (listToMaybe)
-import Data.List (groupBy) -- , transpose)
-
-import GF.Data.BacktrackM
-
-----------------------------------------------------------------------
-
---convertGrammar :: Grammar -> MCF.Grammar
-convertGrammar rules = tracePrt "#mcf-rules total" (prt . length) $
-		       solutions conversion rules undefined
-    where conversion = member rules >>= convertRule
-
---convertRule :: Rule -> CnvMonad MCF.Rule
-convertRule (Rule fun (cat :@ _, decls) (Just (term, ctype)))
-    = do let args = [ arg | _ ::: (arg :@ _) <- decls ]
-	 writeState (initialMCat cat, map initialMCat args, [])
-	 convertTerm cat term
-	 (newCat, newArgs, linRec) <- readState
-	 let newTerm = map (instLin newArgs) linRec
-	 return (MCF.Rule newCat newArgs newTerm fun)	 
-convertRule _ = failure
-
-instLin newArgs (MCF.Lin lbl lin) = MCF.Lin lbl (map instSym lin)
-    where instSym = mapSymbol instCat id
-	  instCat (_, lbl, arg) = (newArgs !! arg, lbl, arg)
-
---convertTerm :: Cat -> Term -> CnvMonad ()
-convertTerm cat term = do rterm <- simplifyTerm term
-			  env <- readEnv
-			  let ctype = lookupCType env cat
-			  reduce ctype rterm emptyPath
-
-------------------------------------------------------------
-
-{-
-type CnvMonad a = BacktrackM Grammar CMRule a
-
-type CMRule = (MCFCat, [MCFCat], LinRec)
-type LinRec = [Lin Cat Path Tokn]
--}
-
---initialMCat :: Cat -> MCFCat
-initialMCat cat = (cat, []) --MCFCat cat []
-
-----------------------------------------------------------------------
-
---simplifyTerm :: Term -> CnvMonad STerm
-simplifyTerm (con :^ terms) = liftM (con :^) $ mapM simplifyTerm terms
-simplifyTerm (Rec record)   = liftM Rec      $ mapM simplifyAssign record
-simplifyTerm (term :. lbl)  = liftM (+. lbl) $      simplifyTerm term
-simplifyTerm (Tbl table)    = Tbl $ mapM simplifyCase table
-simplifyTerm (term :! sel)      
-    = do sterm <- simplifyTerm term
-	 ssel <- simplifyTerm sel
-	 case sterm of
-	   Tbl table  -> do (pat, val) <- member table
-			    pat =?= ssel
-			    return val
-	   _ -> do sel' <- expandTerm ssel
-		   return (sterm +! sel')
-simplifyTerm (Variants terms)  = liftM Variants $ mapM simplifyTerm terms
-simplifyTerm (term1 :++ term2) = liftM2 (:++) (simplifyTerm term1) (simplifyTerm term2)
-simplifyTerm term              = return term
--- error constructors:
---   (I CIdent) - from resource
---   (LI Ident) - pattern variable
---   (EInt Integer) - integer
-
---simplifyAssign :: Assign -> CnvMonad (Label, STerm)
-simplifyAssign (lbl, term) = liftM ((,) lbl) $ simplifyTerm term
-
---simplifyCase :: Case -> [CnvMonad (STerm, STerm)]
-simplifyCase (pat, term) = liftM2 (,) (simplifyTerm pat) (simplifyTerm term)
-
-
-------------------------------------------------------------
--- reducing simplified terms, collecting mcf rules
-
---reduce :: CType -> STerm -> Path -> CnvMonad ()
-reduce StrT   term path = updateLin (path, term)
-reduce (ConT _) term path
-    = do pat <- expandTerm term
-	 updateHead (path, pat)
-reduce ctype (Variants terms) path 
-    = do term <- member terms
-	 reduce ctype term path
-reduce (RecT rtype) term path
-    = sequence_ [ reduce ctype (term +. lbl) (path ++. lbl) |
-		  (lbl, ctype) <- rtype ]
-reduce (TblT _ ctype) (Tbl table) path
-    = sequence_ [ reduce ctype term (path ++! pat) |
-		  (pat, term) <- table ]
-reduce (TblT ptype vtype) arg@(Arg _ _ _) path 
-    = do env <- readEnv
-	 sequence_ [ reduce vtype (arg +! pat) (path ++! pat) |
-		     pat <- groundTerms ptype ]
-reduce ctype term path = error ("reduce:\n  ctype = (" ++ show ctype ++ 
-				")\n  term = (" ++ show term ++ 
-				")\n  path = (" ++ show path ++ ")\n")
-
-
-------------------------------------------------------------
--- expanding a term to ground terms
-
---expandTerm :: STerm -> CnvMonad STerm
-expandTerm arg@(Arg _ _ _) 
-    = do env <- readEnv
-	 pat <- member $ groundTerms $ cTypeForArg env arg
-	 pat =?= arg
-	 return pat
-expandTerm (con :^ terms)  = liftM (con :^) $ mapM expandTerm terms
-expandTerm (Rec record)     = liftM  Rec      $ mapM expandAssign record
-expandTerm (Variants terms) = member terms >>= expandTerm
-expandTerm term = error $ "expandTerm: " ++ show term
-
---expandAssign :: (Label, STerm) -> CnvMonad (Label, STerm)
-expandAssign (lbl, term)   = liftM ((,) lbl) $ expandTerm term
-
-------------------------------------------------------------
--- unification of patterns and selection terms
-
---(=?=) :: STerm -> STerm -> CnvMonad ()
-Wildcard     =?= _                = return ()
-Rec precord  =?= arg@(Arg _ _ _) = sequence_ [ pat =?= (arg +. lbl) |
-						 (lbl, pat) <- precord ]
-pat           =?= Arg arg _ path  = updateArg arg (path, pat)
-(con :^ pats) =?= (con' :^ terms)  = do guard (con==con' && length pats==length terms)
-					sequence_ $ zipWith (=?=) pats terms
-Rec precord  =?= Rec record      = sequence_ [ maybe mzero (pat =?=) mterm |
-						 (lbl, pat) <- precord,
-						 let mterm = lookup lbl record ]
-pat =?= term = error $ "(=?=): " ++ show pat ++ " =?= " ++ show term
-
-
-------------------------------------------------------------
--- updating the mcf rule
-
---updateArg :: Int -> Constraint -> CnvMonad ()
-updateArg arg cn
-    = do (head, args, lins) <- readState 
-	 args' <- updateNth (addToMCFCat cn) arg args
-	 writeState (head, args', lins)
-
---updateHead :: Constraint -> CnvMonad ()
-updateHead cn
-    = do (head, args, lins) <- readState
-	 head' <- addToMCFCat cn head
-	 writeState (head', args, lins)
-
---updateLin :: Constraint -> CnvMonad ()
-updateLin (path, term) 
-    = do let newLins = term2lins term
-	 (head, args, lins) <- readState
-	 let lins' = lins ++ map (MCF.Lin path) newLins
-	 writeState (head, args, lins')
-
---term2lins :: STerm -> [[Symbol (Cat, Path, Int) Tokn]]
-term2lins (Arg arg cat path) = return [Cat (cat, path, arg)]
-term2lins (Token str)        = return [Tok str]
-term2lins (t1 :++ t2)     = liftM2 (++) (term2lins t1) (term2lins t2)
-term2lins (Empty)            = return []
-term2lins (Variants terms)   = terms >>= term2lins
-term2lins term = error $ "term2lins: " ++ show term
-
---addToMCFCat :: Constraint -> MCFCat -> CnvMonad MCFCat
-addToMCFCat cn ({-MCFCat-} cat, cns) = liftM ({-MCFCat-} (,) cat) $ addConstraint cn cns
-
---addConstraint :: Constraint -> [Constraint] -> CnvMonad [Constraint]
-addConstraint cn0 (cn : cns)
-    | fst cn0 >  fst cn = liftM (cn:) (addConstraint cn0 cns)
-    | fst cn0 == fst cn = guard (snd cn0 == snd cn) >>
-			  return (cn : cns)
-addConstraint cn0 cns   = return (cn0 : cns)
-
-
-----------------------------------------------------------------------
--- utilities 
-
-updateNth :: Monad m => (a -> m a) -> Int -> [a] -> m [a]
-updateNth update 0 (a : as) = liftM (:as) (update a)
-updateNth update n (a : as) = liftM (a:)  (updateNth update (n-1) as)
-
---lookupCType :: GrammarEnv -> Cat -> CType
-lookupCType env cat = errVal defLinType $ 
-		      lookupLincat (fst env) (AbsGFC.CIQ (snd env) cat)
-
---groundTerms :: GrammarEnv -> CType -> [STerm]
-groundTerms env ctype = err error (map term2spattern) $
-			allParamValues (fst env) ctype
-
---cTypeForArg :: GrammarEnv -> STerm -> CType
-cTypeForArg env (Arg nr cat (Path path))
-    = follow path $ lookupCType env cat
-    where follow [] ctype = ctype
-	  follow (Right pat : path) (TblT _ ctype) = follow path ctype
-	  follow (Left lbl : path) (RecT rec)
-	      = case [ ctype | (lbl', ctype) <- rec, lbl == lbl' ] of
-		  [ctype] -> follow path ctype
-		  err     -> error $ "follow: " ++ show rec ++ " . " ++ show lbl ++ 
-			             " results in " ++ show err
-
-term2spattern (AbsGFC.R rec)         = Rec [ (lbl, term2spattern term) | 
-					     AbsGFC.Ass lbl term <- rec ]
-term2spattern (AbsGFC.Con con terms) = con :^ map term2spattern terms
-