1 files changed, 0 insertions, 106 deletions
diff --git a/src/GF/CF/Profile.hs b/src/GF/CF/Profile.hs
deleted file mode 100644
index e573bec78..000000000
--- a/src/GF/CF/Profile.hs
+++ /dev/null
@@ -1,106 +0,0 @@
-----------------------------------------------------------------------
--- |
--- Module      : Profile
--- Maintainer  : AR
--- Stability   : (stable)
--- Portability : (portable)
---
--- > CVS $Date: 2005/04/21 16:21:14 $ 
--- > CVS $Author: bringert $
--- > CVS $Revision: 1.8 $
---
--- restoring parse trees for discontinuous constituents, bindings, etc. AR 25/1/2001
--- revised 8/4/2002 for the new profile structure
------------------------------------------------------------------------------
-
-module GF.CF.Profile (postParse) where
-
-import GF.Canon.AbsGFC
-import GF.Canon.GFC
-import qualified GF.Infra.Ident as I
-import GF.Canon.CMacros
----import MMacros
-import GF.CF.CF
-import GF.CF.CFIdent
-import GF.CF.PPrCF -- for error msg
-import GF.Grammar.PrGrammar
-
-import GF.Data.Operations
-
-import Control.Monad
-import Data.List (nub)
-
--- | the job is done in two passes: 
--- 
---   1. tree2term: restore constituent order from Profile 
--- 
---   2. term2trm:  restore Bindings from Binds
-postParse :: CFTree -> Err Exp
-postParse tree = do
-  iterm <- errIn ("postprocessing parse tree" +++ prCFTree tree) $ tree2term tree
-  return $ term2trm  iterm
-
--- | an intermediate data structure
-data ITerm = ITerm (Atom, BindVs) [ITerm] | IMeta   deriving (Eq,Show)
-type BindVs = [[I.Ident]]
-
--- | (1) restore constituent order from Profile 
-tree2term :: CFTree -> Err ITerm
--- tree2term (CFTree (f,(_,[t]))) | f == dummyCFFun = tree2term t -- not used
-tree2term (CFTree (cff@(CFFun (fun,pro)), (_,trees))) = case fun of
-  AM _ -> return IMeta
-  _ -> do
-    args  <- mapM mkArg pro
-    binds <- mapM mkBinds pro
-    return $ ITerm (fun, binds) args
- where
-   mkArg (_,arg) = case arg of
-     [x] -> do               -- one occurrence
-       trx <- trees !? x
-       tree2term trx
-     []  -> return IMeta     -- suppression
-     _   -> do               -- reduplication
-       trees' <- mapM (trees !?) arg
-       xs1    <- mapM tree2term trees' 
-       xs2    <- checkArity xs1
-       unif xs2
-
-   checkArity xs = if length (nub [length xx | ITerm _ xx <- xs']) > 1 
-                   then Bad "arity error" 
-                   else return xs'
-           where xs' = [t | t@(ITerm _ _) <- xs]
-   unif xs = case [t | t@(ITerm _ _) <- xs] of 
-    [] -> return $ IMeta
-    (ITerm fp@(f,_) xx : ts) -> do
-      let hs = [h | ITerm (h,_) _ <- ts, h /= f]
-      testErr (null hs)                 -- if fails, hs must be nonempty
-              ("unification expects" +++ prt f +++ "but found" +++ prt (head hs))
-      xx' <- mapM unifArg [0 .. length xx - 1]
-      return $ ITerm fp xx'
-    where
-      unifArg i = unif [zz !! i | ITerm _ zz <- xs]
-
-   mkBinds (xss,_) = mapM mkBind xss
-   mkBind xs = do
-     ts <- mapM (trees !?) xs
-     let vs = [x | CFTree (CFFun (AV x,_),(_,[])) <- ts]
-     testErr (length ts == length vs) "non-variable in bound position"
-     case vs of
-       [x]  -> return x
-       []   -> return $ I.identC "h_" ---- uBoundVar
-       y:ys -> do
-         testErr (all (==y) ys) ("fail to unify bindings of" +++ prt y)
-         return y
-
--- | (2) restore Bindings from Binds
-term2trm :: ITerm -> Exp 
-term2trm IMeta = EAtom (AM 0) ---- mExp0
-term2trm (ITerm (fun, binds) terms) =
-  let bterms = zip binds terms
-  in mkAppAtom fun [mkAbsR xs (term2trm t) |  (xs,t) <- bterms]
-
- --- these are deprecated
- where
-   mkAbsR c e = foldr EAbs e c
-   mkAppAtom a = mkApp (EAtom a)
-   mkApp = foldl EApp