remove all files that aren't used in GF-3.0

1 files changed, 0 insertions, 178 deletions

diff --git a/src-3.0/GF/Conversion/SimpleToFinite.hs b/src-3.0/GF/Conversion/SimpleToFinite.hs
deleted file mode 100644
index bbd3ae355..000000000
--- a/src-3.0/GF/Conversion/SimpleToFinite.hs
+++ /dev/null
@@ -1,178 +0,0 @@
-----------------------------------------------------------------------
--- |
--- Maintainer  : PL
--- Stability   : (stable)
--- Portability : (portable)
---
--- > CVS $Date: 2005/09/01 09:53:19 $ 
--- > CVS $Author: peb $
--- > CVS $Revision: 1.7 $
---
--- Calculating the finiteness of each type in a grammar
------------------------------------------------------------------------------
-
-module GF.Conversion.SimpleToFinite
-    (convertGrammar) where
-
-import GF.System.Tracing
-import GF.Infra.Print
-
-import GF.Formalism.GCFG
-import GF.Formalism.SimpleGFC
-import GF.Formalism.Utilities 
-import GF.Conversion.Types
-
-import GF.Data.SortedList
-import GF.Data.Assoc
-import GF.Data.BacktrackM
-import GF.Data.Utilities (lookupList)
-
-import GF.Infra.Ident (Ident(..))
-
-type CnvMonad a = BacktrackM () a
-
-convertGrammar :: SGrammar -> SGrammar
-convertGrammar rules = tracePrt "SimpleToFinie - nr. 'finite' rules" (prt . length) $
-		       solutions cnvMonad ()
-    where split = calcSplitable rules
-	  cnvMonad = member rules >>= convertRule split
-
-convertRule :: Splitable -> SRule -> CnvMonad SRule
-convertRule split (Rule abs cnc) 
-    = do newAbs <- convertAbstract split abs
-	 return $ Rule newAbs cnc
-
-{-
--- old code
-convertAbstract :: Splitable -> Abstract SDecl Name
-		-> CnvMonad (Abstract SDecl Name)
-convertAbstract split (Abs decl decls name)
-    = case splitableFun split (name2fun name) of
-        Just cat' -> return $ Abs (Decl anyVar (mergeFun (name2fun name) cat') []) decls name
-	Nothing -> expandTyping split name [] decl decls []
-
-
-expandTyping :: Splitable -> Name -> [(Var, SCat)] -> SDecl -> [SDecl] -> [SDecl] 
-	     -> CnvMonad (Abstract SDecl Name)
-expandTyping split name env (Decl x cat args) [] decls 
-    = return $ Abs decl (reverse decls) name
-    where decl = substArgs split x env cat args []
-expandTyping split name env typ (Decl x xcat xargs : declsToDo) declsDone
-    = do (x', xcat', env') <- calcNewEnv
-         let decl = substArgs split x' env xcat' xargs []
-	 expandTyping split name env' typ declsToDo (decl : declsDone)
-    where calcNewEnv = case splitableCat split xcat of
-		         Just newFuns -> do newFun <- member newFuns
-                                            let newCat  = mergeFun newFun xcat
-		         -- Just newCats -> do newCat <- member newCats
-					    return (anyVar, newCat, (x,newCat) : env)
-			 Nothing -> return (x, xcat, env)
--}
-
--- new code
-convertAbstract :: Splitable -> Abstract SDecl Name
-		-> CnvMonad (Abstract SDecl Name)
-convertAbstract split (Abs decl decls name)
-    = case splitableFun split fun of
-        Just cat' -> return $ Abs (Decl anyVar ([] ::--> (mergeFun fun cat' ::@ []))) decls name
-	Nothing -> expandTyping split [] fun profiles [] decl decls []
-    where Name fun profiles = name
-
-expandTyping :: Splitable -> [(Var, SCat)]
-             -> Fun -> [Profile (SyntaxForest Fun)] -> [Profile (SyntaxForest Fun)] 
-             -> SDecl -> [SDecl] -> [SDecl] 
-	     -> CnvMonad (Abstract SDecl Name)
-expandTyping split env fun [] profiles (Decl x (typargs ::--> (cat ::@ args))) [] decls 
-    = return $ Abs decl (reverse decls) (Name fun (reverse profiles))
-    where decl = substArgs split x env typargs cat args []
-expandTyping split env fun (prof:profiles) profsDone typ 
-                 (Decl x (xtypargs ::--> (xcat ::@ xargs)) : declsToDo) declsDone
-    = do (x', xcat', env', prof') <- calcNewEnv
-         let decl = substArgs split x' env xtypargs xcat' xargs []
-	 expandTyping split env' fun profiles (prof' : profsDone) typ declsToDo (decl : declsDone)
-    where calcNewEnv = case splitableCat split xcat of
-			 Nothing      -> return (x, xcat, env, prof)
-		         Just newFuns -> do newFun <- member newFuns
-                                            let newCat  = mergeFun newFun xcat
-                                                newProf = Constant (FNode newFun [[]])
-                                            -- should really be using some kind of
-                                            -- "profile unification"
-					    return (anyVar, newCat, (x,newCat) : env, newProf)
-
-substArgs :: Splitable -> Var -> [(Var, SCat)] -> [FOType SCat]
-	  -> SCat -> [TTerm] -> [TTerm] -> SDecl
-substArgs split x env typargs cat [] args = Decl x (typargs ::--> (cat ::@ reverse args))
-substArgs split x env typargs cat (arg:argsToDo) argsDone
-    = case argLookup split env arg of
-        Just newCat -> substArgs split x env typargs (mergeArg cat newCat) argsToDo argsDone
-	Nothing     -> substArgs split x env typargs cat argsToDo (arg : argsDone)
-
-argLookup split env (TVar x)   = lookup x env 
-argLookup split env (con :@ _) = fmap (mergeFun fun) (splitableFun split fun)
-    where fun = constr2fun con
-      
-
-----------------------------------------------------------------------
--- splitable categories (finite, no dependencies)
--- they should also be used as some dependency
-
-type Splitable = (Assoc SCat [Fun], Assoc Fun SCat)
-
-splitableCat :: Splitable -> SCat -> Maybe [Fun]
-splitableCat = lookupAssoc . fst 
-
-splitableFun :: Splitable -> Fun -> Maybe SCat
-splitableFun = lookupAssoc . snd
-
-calcSplitable :: [SRule] -> Splitable
-calcSplitable rules = (listAssoc splitableCat2Funs, listAssoc splitableFun2Cat)
-    where splitableCat2Funs = groupPairs $ nubsort splitableCatFuns
-
-	  splitableFun2Cat = nubsort
-			     [ (fun, cat) | (cat, fun) <- splitableCatFuns ]
-
-          -- cat-fun pairs that are splitable
-	  splitableCatFuns = tracePrt "SimpleToFinite - splitable functions" prt $
-                             [ (cat, name2fun name) |
-			       Rule (Abs (Decl _ ([] ::--> (cat ::@ []))) [] name) _ <- rules,
-			       splitableCats ?= cat ]
-
-          -- all cats that are splitable
-          splitableCats = listSet $
-			  tracePrt "SimpleToFinite - finite categories to split" prt $
-			  (nondepCats <**> depCats) <\\> resultCats
-
-          -- all result cats for some pure function
-	  resultCats = tracePrt "SimpleToFinite - result cats" prt $
-                       nubsort [ cat | Rule (Abs (Decl _ (_ ::--> (cat ::@ _))) decls _) _ <- rules,
-				 not (null decls) ]
-
-          -- all cats in constants without dependencies
-          nondepCats = tracePrt "SimpleToFinite - nondep cats" prt $
-                       nubsort [ cat | Rule (Abs (Decl _ ([] ::--> (cat ::@ []))) [] _) _ <- rules ]
-
-          -- all cats occurring as some dependency of another cat
-	  depCats = tracePrt "SimpleToFinite - dep cats" prt $
-                    nubsort [ cat | Rule (Abs decl decls _) _ <- rules,
-			      cat <- varCats [] (decls ++ [decl]) ]
-
-	  varCats _ [] = []
-	  varCats env (Decl x (xargs ::--> xtyp@(xcat ::@ _)) : decls)
-	      = varCats ((x,xcat) : env) decls ++
-		[ cat | (_::@args) <- (xtyp:xargs), arg <- args, 
-                  y <- varsInTTerm arg, cat <- lookupList y env ]
-
-
-----------------------------------------------------------------------
--- utilities
--- mergeing categories
-
-mergeCats :: String -> String -> String -> SCat -> SCat -> SCat
-mergeCats before middle after (IC cat) (IC arg) 
-    = IC (before ++ cat ++ middle ++ arg ++ after)
-
-mergeFun, mergeArg :: SCat -> SCat -> SCat
-mergeFun = mergeCats "{" ":" "}"
-mergeArg = mergeCats "" "" ""
-
-