removed src for 2.9

1 files changed, 0 insertions, 225 deletions

diff --git a/src/GF/Canon/Look.hs b/src/GF/Canon/Look.hs
deleted file mode 100644
index a93d4c834..000000000
--- a/src/GF/Canon/Look.hs
+++ /dev/null
@@ -1,225 +0,0 @@
-----------------------------------------------------------------------
--- |
--- Module      : Look
--- Maintainer  : AR
--- Stability   : (stable)
--- Portability : (portable)
---
--- > CVS $Date: 2005/09/20 09:32:56 $ 
--- > CVS $Author: aarne $
--- > CVS $Revision: 1.17 $
---
--- lookup in GFC. AR 2003
------------------------------------------------------------------------------
-
-module GF.Canon.Look (lookupCncInfo,
-	     lookupLin,
-	     lookupLincat,
-	     lookupPrintname,
-	     lookupResInfo,
-	     lookupGlobal,
-	     lookupOptionsCan,
-	     lookupParamValues,
-	     allParamValues,
-	     ccompute
-	    ) where
-
-import GF.Canon.AbsGFC
-import GF.Canon.GFC
-import GF.Grammar.PrGrammar
-import GF.Canon.CMacros
-----import Values
-import GF.Grammar.MMacros
-import GF.Grammar.Macros (zIdent)
-import qualified GF.Infra.Modules as M
-import qualified GF.Canon.CanonToGrammar as CG
-
-import GF.Data.Operations
-import GF.Infra.Option
-
-import Control.Monad
-import Data.List
-
--- linearization lookup
-
-lookupCncInfo :: CanonGrammar -> CIdent -> Err Info
-lookupCncInfo gr f@(CIQ m c) = do
-  mt <- M.lookupModule gr m
-  case mt of
-    M.ModMod a -> errIn ("module" +++ prt m) $ 
-                  lookupIdent c $ M.jments a 
-    _ -> prtBad "not concrete module" m
-
-lookupLin :: CanonGrammar -> CIdent -> Err Term
-lookupLin gr f = errIn "looking up linearization rule" $ do
-  info <- lookupCncInfo gr f
-  case info of
-    CncFun _ _ t _ -> return t
-    CncCat _ t _ -> return t
-    AnyInd _ n -> lookupLin gr $ redirectIdent n f
-
-lookupLincat :: CanonGrammar -> CIdent -> Err CType
-lookupLincat gr (CIQ _ c) | elem c [zIdent "String", zIdent "Int", zIdent "Float"] =
-  return defLinType --- ad hoc; not needed? cf. Grammar.Lookup.lookupLincat
-lookupLincat gr f = errIn "looking up linearization type" $ do
-  info <- lookupCncInfo gr f
-  case info of
-    CncCat t _ _ -> return t
-    AnyInd _ n -> lookupLincat gr $ redirectIdent n f
-    _ -> prtBad "no lincat found for" f
-
-lookupPrintname :: CanonGrammar -> CIdent -> Err Term
-lookupPrintname gr f = errIn "looking up printname" $ do
-  info <- lookupCncInfo gr f
-  case info of
-    CncFun _ _ _ t -> return t
-    CncCat _ _ t -> return t
-    AnyInd _ n -> lookupPrintname gr $ redirectIdent n f
-
-lookupResInfo :: CanonGrammar -> CIdent -> Err Info
-lookupResInfo gr f@(CIQ m c) = do
-  mt <- M.lookupModule gr m
-  case mt of
-    M.ModMod a -> lookupIdent c $ M.jments a 
-    _ -> prtBad "not resource module" m
-
-lookupGlobal :: CanonGrammar -> CIdent -> Err Term
-lookupGlobal gr f = do
-  info <- lookupResInfo gr f
-  case info of
-    ResOper _ t -> return t
-    AnyInd _ n -> lookupGlobal gr $ redirectIdent n f
-    _ -> prtBad "cannot find global" f
-
-lookupOptionsCan :: CanonGrammar -> Err Options
-lookupOptionsCan gr = do
-  let fs = M.allFlags gr
-  os <- mapM CG.redFlag fs
-  return $ options os
-
-lookupParamValues :: CanonGrammar -> CIdent -> Err [Term]
-lookupParamValues gr pt@(CIQ m _) = do
-  info <- lookupResInfo gr pt
-  case info of
-    ResPar ps -> liftM concat $ mapM mkPar ps
-    AnyInd _ n -> lookupParamValues gr $ redirectIdent n pt
-    _ -> prtBad "cannot find parameter type" pt
- where
-   mkPar (ParD f co) = do
-     vs <- liftM combinations $ mapM (allParamValues gr) co
-     return $ map (Par (CIQ m f)) vs
-
--- this is needed since param type can also be a record type
-
-allParamValues :: CanonGrammar -> CType -> Err [Term]
-allParamValues cnc ptyp = case ptyp of
-  Cn pc -> lookupParamValues cnc pc
-  RecType r -> do
-    let (ls,tys) = unzip [(l,t) | Lbg l t <- r]
-    tss <- mapM allPV tys
-    return [R (map (uncurry Ass) (zip ls ts)) | ts <- combinations tss]
-  TInts n -> return [EInt i | i <- [0..n]]
-  _ -> prtBad "cannot possibly find parameter values for" ptyp
- where
-   allPV = allParamValues cnc
-
--- runtime computation on GFC objects
-
-ccompute :: CanonGrammar -> [Term] -> Term -> Err Term
-ccompute cnc = vcomp
- where
-
-  vcomp xs t = do
-    let xss = variations xs
-    ts <- mapM (\xx -> comp [] xx t) xss
-    return $ variants ts
-
-  variations xs = combinations [getVariants t | t <- xs]
-  variants ts = case ts of
-    [t] -> t
-    _ -> FV ts
-  getVariants t = case t of
-    FV ts -> ts
-    _ -> [t]
-
-  comp g xs t = case t of
-    Arg (A _ i)    -> err (const (return t)) return $ xs !? fromInteger i
-    Arg (AB _ _ i) -> err (const (return t)) return $ xs !? fromInteger i
-    I c     -> look c 
-    LI c    -> lookVar c g
-
-    -- short-cut computation of selections: compute the table only if needed
-    S u v   -> do
-      u' <- compt u
-      case u' of
-        T _ [Cas [PW] b] -> compt b  
-        T _ [Cas [PV x] b] -> do
-          v' <- compt v
-          comp ((x,v') : g) xs b  
-        T _ cs -> do
-          v' <- compt v
-          if noVar v' 
-             then matchPatt cs v' >>= compt
-             else return $ S u' v'
-        FV ccs -> do
-          v' <- compt v
-          mapM (\c -> compt (S c v')) ccs >>= return . FV
-
-        _      -> liftM (S u') $ compt v
-
-    P u l  -> do
-      u' <- compt u
-      case u' of
-        R rs -> maybe (Bad ("unknown label" +++ prt l +++ "in" +++ prt u'))
-                      return $ 
-                        lookup l [ (x,y) | Ass x y <- rs]
-        FV rrs -> do
-          mapM (\r -> compt (P r l)) rrs >>= return . FV
-
-        _    -> return $ P u' l
-    FV ts    -> liftM FV (mapM compt ts)
-    C E b    -> compt b
-    C a E    -> compt a
-    C a b    -> do
-      a' <- compt a
-      b' <- compt b
-      return $ case (a',b') of
-        (E,_) -> b'
-        (_,E) -> a'
-        _     -> C a' b'
-    R rs     -> liftM (R . map (uncurry Ass)) $ 
-                  mapPairsM compt [(l,r) | Ass l r <- rs]
-
-    -- only expand the table when the table is really needed: use expandLin
-    T ty rs -> liftM (T ty . map (uncurry Cas)) $ 
-                  mapPairsM compt [(l,r) | Cas l r <- rs]
-
-    V ptyp ts -> do
-      ts' <- mapM compt ts
-      vs0 <- allParamValues cnc ptyp
-      vs  <- mapM term2patt vs0
-      let cc = [Cas [p] u | (p,u) <- zip vs ts']
-      return $ T ptyp cc
-
-    Par c xs -> liftM (Par c) $ mapM compt xs
-
-    K (KS []) -> return E --- should not be needed
-
-    _        -> return t  
-   where
-     compt = comp g xs
-     look c = lookupGlobal cnc c >>= compt
-
-     lookVar c co = case lookup c co of
-       Just t -> return t
-       _ -> return $ LI c --- Bad $ "unknown local variable" +++ prt c --- 
-
-     noVar v = case v of
-       LI _ -> False
-       Arg _ -> False
-       R rs -> all noVar [t | Ass _ t <- rs]
-       Par _ ts -> all noVar ts
-       FV ts -> all noVar ts
-       S x y -> noVar x && noVar y
-       P t _ -> noVar t
-       _    -> True --- other cases that can be values to pattern match?