Comment out some dead code found with -fwarn-unused-binds

Also fixed some warnings and tightened some imports

src/binary/Data/Binary/Put.hs

@@ -61,7 +61,7 @@ import Control.Applicative
 ------------------------------------------------------------------------
 
 -- XXX Strict in buffer only. 
-data PairS a = PairS a {-# UNPACK #-}!Builder
+data PairS a = PairS a {-UNPACK-}!Builder
 
 sndS :: PairS a -> Builder
 sndS (PairS _ b) = b

src/compiler/GF/Command/Interpreter.hs

@@ -9,7 +9,6 @@ import GF.Command.Parse
 import PGF.Internal(Expr(..))
 import GF.Infra.UseIO(putStrLnE)
 
-import GF.Text.Pretty(render)
 import Control.Monad(when)
 import qualified Data.Map as Map
 

src/compiler/GF/Command/TreeOperations.hs

@@ -4,7 +4,7 @@ module GF.Command.TreeOperations (
   treeChunks
   ) where
 
-import PGF
+import PGF(PGF,CId,compute,unApp,paraphrase)
 import PGF.Internal(Expr(..),unAppForm)
 import Data.List
 

src/compiler/GF/Compile/Compute/ConcreteNew.hs

@@ -33,7 +33,7 @@ nfx env@(GE _ _ _ loc) t = value2term loc [] # eval env t
 eval :: GlobalEnv -> Term -> Err Value
 eval ge t = ($[]) # value (toplevel ge) t
 
-apply env = apply' env
+--apply env = apply' env
 
 --------------------------------------------------------------------------------
 
@@ -279,7 +279,7 @@ strsFromValue t = case t of
     d0 <- strsFromValue d
     v0 <- mapM (strsFromValue . fst) vs
     c0 <- mapM (strsFromValue . snd) vs
-    let vs' = zip v0 c0
+  --let vs' = zip v0 c0
     return [strTok (str2strings def) vars | 
               def  <- d0,
               vars <- [[(str2strings v, map sstr c) | (v,c) <- zip vv c0] | 
@@ -511,11 +511,11 @@ ix loc fn xs i =
     else bugloc loc $ "(!!): index too large in "++fn++", "++show i++"<"++show n
   where n = length xs
 
-infixl 1 #,<#,@@
+infixl 1 #,<# --,@@
 
 f # x = fmap f x
 mf <# mx  = ap mf mx
-m1 @@ m2 = (m1 =<<) . m2
+--m1 @@ m2 = (m1 =<<) . m2
 
 both f (x,y) = (,) # f x <# f y
 

src/compiler/GF/Compile/Compute/Predef.hs

@@ -2,7 +2,7 @@
 {-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-}
 module GF.Compile.Compute.Predef(predef,predefName,delta) where
 
-import GF.Text.Pretty(render,hang)
+--import GF.Text.Pretty(render,hang)
 import qualified Data.Map as Map
 import Data.Array(array,(!))
 import Data.List (isInfixOf)
@@ -146,11 +146,11 @@ norm v =
                   (VString s1,VString s2) -> VString (s1++" "++s2)
                   (v1,v2) -> VC v1 v2
     _ -> v
-
+{-
 strict v = case v of
              VError err -> Left err
              _ -> Right v
-
+-}
 string s = case words s of
              [] -> VString ""
              ss -> foldr1 VC (map VString ss)
@@ -158,7 +158,8 @@ string s = case words s of
 ---
 
 swap (x,y) = (y,x)
-
+{-
 bug msg = ppbug msg
 ppbug doc = error $ render $
                     hang "Internal error in Compute.Predef:" 4 doc
+-}

src/compiler/GF/Compile/ConcreteToHaskell.hs

@@ -126,7 +126,7 @@ toHaskell gId gr absname cenv (name,jment) =
         [Right (cat,(Eqn (prefixIdent "lin" cat,lhs),coerce [] lincat rhs))]
       where
         Ok abstype = lookupFunType gr absname name
-        (absctx,abscat,absargs) = typeForm abstype
+        (absctx,_abscat,_absargs) = typeForm abstype
 
         e' = unAbs (length params) $
              nf loc (mkAbs params (mkApp def (map Vr args)))

src/compiler/GF/Compile/GenerateBC.hs

@@ -149,7 +149,7 @@ compileFun gr eval st vs (Let (x, (_, e1)) e2) h0 bs args =
 compileFun gr eval st vs e@(Glue e1 e2) h0 bs args =
   let eval' st fun args = [PUSH_FRAME]++is++[EVAL fun' RecCall]
                           where
-                            (st1,is) = pushArgs (st+2) (reverse args)
+                            (_st1,is) = pushArgs (st+2) (reverse args)
                             fun'     = shiftIVal st fun
 
       flatten (Glue e1 e2) h0 bs =

src/compiler/GF/Compile/GrammarToPGF.hs

@@ -177,8 +177,8 @@ genCncCats gr am cm cdefs =
                 (index',cats) = mkCncCats index cdefs
             in (index', (i2i id,cc) : cats)
       | otherwise     =
-            let cc@(C.CncCat s e _) = pgfCncCat gr lincat index
+            let cc@(C.CncCat _s e _) = pgfCncCat gr lincat index
-                (index',cats)       = mkCncCats (e+1) cdefs
+                (index',cats)        = mkCncCats (e+1) cdefs
             in (index', (i2i id,cc) : cats)
     mkCncCats index (_                      :cdefs) = mkCncCats index cdefs
 
@@ -303,6 +303,6 @@ genPrintNames cdefs =
     flatten (Alts x _) = flatten x
     flatten (C x y)    = flatten x +++ flatten y
 
-mkArray    lst = listArray (0,length lst-1) lst
+--mkArray    lst = listArray (0,length lst-1) lst
 mkMapArray map = array (0,Map.size map-1) [(v,k) | (k,v) <- Map.toList map]
 mkSetArray set = listArray (0,Set.size set-1) [v | v <- Set.toList set]

src/compiler/GF/Compile/PGFtoHaskell.hs

@@ -273,13 +273,13 @@ hSkeleton gr =
    valtyps (_, (_,x)) (_, (_,y)) = compare x y
    valtypg (_, (_,x)) (_, (_,y)) = x == y
    jty (f,(ty,_,_,_)) = (f,catSkeleton ty)
-
+{-
 updateSkeleton :: OIdent -> HSkeleton -> (OIdent, [OIdent]) -> HSkeleton
 updateSkeleton cat skel rule =
  case skel of
    (cat0,rules):rr | cat0 == cat -> (cat0, rule:rules) : rr
    (cat0,rules):rr               -> (cat0, rules) : updateSkeleton cat rr rule
-
+-}
 isListCat :: (OIdent, [(OIdent, [OIdent])]) -> Bool
 isListCat (cat,rules) = "List" `isPrefixOf` cat && length rules == 2
 		    && ("Base"++c) `elem` fs && ("Cons"++c) `elem` fs
@@ -289,13 +289,13 @@ isListCat (cat,rules) = "List" `isPrefixOf` cat && length rules == 2
 -- | Gets the element category of a list category.
 elemCat :: OIdent -> OIdent
 elemCat = drop 4
-
+{-
 isBaseFun :: OIdent -> Bool
 isBaseFun f = "Base" `isPrefixOf` f
 
 isConsFun :: OIdent -> Bool
 isConsFun f = "Cons" `isPrefixOf` f
-
+-}
 baseSize :: (OIdent, [(OIdent, [OIdent])]) -> Int
 baseSize (_,rules) = length bs
     where Just (_,bs) = find (("Base" `isPrefixOf`) . fst) rules

src/compiler/GF/Compile/PGFtoJS.hs

@@ -51,11 +51,14 @@ concrete2js (c,cnc) =
                                JS.EInt (totalCats cnc)])
   where 
    l  = JS.IdentPropName (JS.Ident (showCId c))
+{-
    litslins = [JS.Prop (JS.StringPropName    "Int") (JS.EFun [children] [JS.SReturn $ new "Arr" [JS.EIndex (JS.EVar children) (JS.EInt 0)]]), 
                JS.Prop (JS.StringPropName  "Float") (JS.EFun [children] [JS.SReturn $ new "Arr" [JS.EIndex (JS.EVar children) (JS.EInt 0)]]),
                JS.Prop (JS.StringPropName "String") (JS.EFun [children] [JS.SReturn $ new "Arr" [JS.EIndex (JS.EVar children) (JS.EInt 0)]])]
+-}
    cats (c,CncCat start end _) = JS.Prop (JS.IdentPropName (JS.Ident (showCId c))) (JS.EObj [JS.Prop (JS.IdentPropName (JS.Ident "s")) (JS.EInt start)
                                                                                             ,JS.Prop (JS.IdentPropName (JS.Ident "e")) (JS.EInt end)])
+{-
 mkStr :: String -> JS.Expr
 mkStr s = new "Str" [JS.EStr s]
 
@@ -65,7 +68,7 @@ mkSeq xs = new "Seq" xs
 
 argIdent :: Integer -> JS.Ident
 argIdent n = JS.Ident ("x" ++ show n)
-
+-}
 children :: JS.Ident
 children = JS.Ident "cs"
 

src/compiler/GF/Compile/TypeCheck/RConcrete.hs

@@ -479,7 +479,7 @@ checkLType gr g trm typ0 = do
 
     R r -> case typ of --- why needed? because inference may be too difficult
        RecType rr -> do
-         let (ls,_) = unzip rr        -- labels of expected type
+       --let (ls,_) = unzip rr        -- labels of expected type
          fsts <- mapM (checkM r) rr   -- check that they are found in the record
          return $ (R fsts, typ)       -- normalize record
 
@@ -556,10 +556,10 @@ checkLType gr g trm typ0 = do
       termWith trm' $ checkEqLType gr g typ ty' trm'
  where
    justCheck g ty te = checkLType gr g ty te >>= return . fst
-
+{-
    recParts rr t = (RecType rr1,RecType rr2) where 
      (rr1,rr2) = partition (flip elem (map fst t) . fst) rr 
-
+-}
    checkM rms (l,ty) = case lookup l rms of
      Just (Just ty0,t) -> do
        checkEqLType gr g ty ty0 t
@@ -747,12 +747,12 @@ ppType ty =
                       _      -> ppTerm Unqualified 0 ty
     Prod _ x a b -> ppType a <+> "->" <+> ppType b
     _            -> ppTerm Unqualified 0 ty
-
+{-
 ppqType :: Type -> Type -> Doc
 ppqType t u = case (ppType t, ppType u) of
   (pt,pu) | render pt == render pu -> ppTerm Qualified 0 t
   (pt,_) -> pt
-
+-}
 checkLookup :: Ident -> Context -> Check Type
 checkLookup x g =
   case [ty | (b,y,ty) <- g, x == y] of

src/compiler/GF/Compile/TypeCheck/TC.hs

@@ -64,8 +64,8 @@ lookupVar g x = maybe (Bad (render ("unknown variable" <+> x))) return $ lookup
 
 type TCEnv = (Int,Env,Env)
 
-emptyTCEnv :: TCEnv
+--emptyTCEnv :: TCEnv
-emptyTCEnv = (0,[],[])
+--emptyTCEnv = (0,[],[])
 
 whnf :: Val -> Err Val
 whnf v = ---- errIn ("whnf" +++ prt v) $ ---- debug

src/compiler/GF/Compiler.hs

@@ -90,7 +90,7 @@ compileCFFiles opts fs = do
                 (CFRule cat _ _ : _) -> return cat
                 _                    -> fail "empty CFG"
   let pgf = cf2pgf (last fs) (uniqueFuns (mkCFG startCat Set.empty rules))
-  let cnc = justModuleName (last fs)
+--let cnc = justModuleName (last fs)
   unless (flag optStopAfterPhase opts == Compile) $
      do probs <- liftIO (maybe (return . defaultProbabilities) readProbabilitiesFromFile (flag optProbsFile opts) pgf)
         let pgf' = setProbabilities probs $ if flag optOptimizePGF opts then optimizePGF pgf else pgf

src/compiler/GF/Data/Relation.hs

@@ -189,5 +189,5 @@ remove x r = let (mss,r') = Map.updateLookupWithKey (\_ _ -> Nothing) x r
 incoming :: Ord a => a -> Rel' a -> Set a
 incoming x r = maybe Set.empty fst $ Map.lookup x r
 
-outgoing :: Ord a => a -> Rel' a -> Set a
+--outgoing :: Ord a => a -> Rel' a -> Set a
-outgoing x r = maybe Set.empty snd $ Map.lookup x r
+--outgoing x r = maybe Set.empty snd $ Map.lookup x r

src/compiler/GF/Data/Str.hs

@@ -20,8 +20,8 @@ module GF.Data.Str (
   allItems
 ) where
 
-import GF.Data.Operations
+import GF.Data.Operations(prQuotedString)
-import Data.List (isPrefixOf, isSuffixOf, intersperse)
+import Data.List (isPrefixOf, intersperse) --, isSuffixOf
 
 -- | abstract token list type. AR 2001, revised and simplified 20\/4\/2003
 newtype Str = Str [Tok]  deriving (Read, Show, Eq, Ord)
@@ -50,11 +50,11 @@ matchPrefix s vs t =
     (u,as) <- vs, 
     any (\c -> isPrefixOf c (concat (unmarkup t))) as
   ] ++ [s]
-
+{-
 matchSuffix :: String -> Ss -> [(Ss,[String])] -> Ss
 matchSuffix t s vs = 
   head ([u | (u,as) <- vs, any (\c -> isSuffixOf c t) as] ++ [s])
-
+-}
 unmarkup :: [String] -> [String]
 unmarkup = filter (not . isXMLtag) where
   isXMLtag s = case s of

src/compiler/GF/Grammar/Analyse.hs

@@ -119,22 +119,22 @@ sizeInfo i = case i of
   msize mt = case mt of
     Just (L _ t) -> sizeTerm t
     _ -> 0
-
+{-
 -- the size of a module
 sizeModule :: SourceModule -> Int
 sizeModule = fst . sizesModule
-
+-}
 sizesModule :: SourceModule -> (Int, [(Ident,Int)])
 sizesModule (_,m) = 
   let 
     js = Map.toList (jments m) 
     tb = [(i,k) | (i,j) <- js, let k = sizeInfo j, k >= 0]
   in (length tb + sum (map snd tb),tb)
-
+{-
 -- the size of a grammar
 sizeGrammar :: Grammar -> Int
 sizeGrammar = fst . sizesGrammar
-
+-}
 sizesGrammar :: Grammar -> (Int,[(ModuleName,(Int,[(Ident,Int)]))])
 sizesGrammar g = 
   let 

src/compiler/GF/Grammar/CFG.hs

@@ -153,13 +153,13 @@ removeLeftRecursion gr
     -- note: the rest don't occur in the original grammar
 
     cats = allCats gr
-    rules = allRules gr
+--  rules = allRules gr
 
     directLeftCorner = mkRel [(NonTerminal c,t) | CFRule c (t:_) _ <- allRules gr]
-    leftCorner = reflexiveClosure_ (map NonTerminal cats) $ transitiveClosure directLeftCorner
+--  leftCorner = reflexiveClosure_ (map NonTerminal cats) $ transitiveClosure directLeftCorner
     properLeftCorner = transitiveClosure directLeftCorner
     properLeftCornersOf = Set.toList . allRelated properLeftCorner . NonTerminal
-    isProperLeftCornerOf = flip (isRelatedTo properLeftCorner)
+--  isProperLeftCornerOf = flip (isRelatedTo properLeftCorner)
 
     leftRecursive = reflexiveElements properLeftCorner
     isLeftRecursive = (`Set.member` leftRecursive)
@@ -167,7 +167,7 @@ removeLeftRecursion gr
     retained = cfgStartCat gr `Set.insert`
                 Set.fromList [a | r <- allRules (filterCFGCats (not . isLeftRecursive . NonTerminal) gr),
                                   NonTerminal a <- ruleRhs r]
-    isRetained = (`Set.member` retained)
+--  isRetained = (`Set.member` retained)
 
     retainedLeftRecursive = filter (isLeftRecursive . NonTerminal) $ Set.toList retained
 

src/compiler/GF/Grammar/EBNF.hs

@@ -49,9 +49,9 @@ normEBNF erules = let
   erules1 = [normERule ([i],r) | (i,r) <- zip [0..] erules]
   erules2 = erules1 ---refreshECats erules1 --- this seems to be just bad !
   erules3 = concat (map pickERules erules2)
-  erules4 = nubERules erules3
+--erules4 = nubERules erules3
  in [(mkCFCatE cat, map eitem2cfitem its) | (cat,itss) <- erules3, its <- itss]
-
+{-
 refreshECats :: [NormERule] -> [NormERule]
 refreshECats rules = [recas [i] rule | (i,rule) <- zip [0..] rules] where
  recas ii (cat,its) = (updECat ii cat, [recss ii 0 s | s <- its])
@@ -63,7 +63,7 @@ refreshECats rules = [recas [i] rule | (i,rule) <- zip [0..] rules] where
    EIPlus (cat,t) -> EIPlus (updECat ii cat, [recss ii 0 s | s <- t])
    EIOpt  (cat,t) -> EIOpt  (updECat ii cat, [recss ii 0 s | s <- t])
    _ -> it
-  
+-}
 pickERules :: NormERule -> [NormERule]
 pickERules rule@(cat,alts) = rule : concat (map pics (concat alts)) where
  pics it = case it of
@@ -77,7 +77,7 @@ pickERules rule@(cat,alts) = rule : concat (map pics (concat alts)) where
                                         where cat' = mkNewECat cat "Plus"
  mkEOptRules cat  = [(cat', [[],[EINonTerm cat]])] 
                                         where cat' = mkNewECat cat "Opt"
-
+{-
 nubERules :: [NormERule] -> [NormERule]
 nubERules rules = nub optim where 
   optim = map (substERules (map mkSubst replaces)) irreducibles
@@ -100,7 +100,7 @@ substERules g (cat,itss) = (cat, map sub itss) where
   sub (EIStar r : ii) = EIStar (substERules g r) : ii
   sub (EIPlus r : ii) = EIPlus (substERules g r) : ii
   sub (EIOpt r : ii)  = EIOpt  (substERules g r) : ii
-
+-}
 eitem2cfitem :: EItem -> CFSymbol
 eitem2cfitem it = case it of
   EITerm a       -> Terminal a
@@ -145,8 +145,8 @@ prECat (c,ints) = c ++ "_" ++ prTList "_" (map show ints)
 
 mkCFCatE :: ECat -> Cat
 mkCFCatE = prECat
-
+{-
 updECat _ (c,[]) = (c,[])
 updECat ii (c,_) = (c,ii)
-
+-}
 mkNewECat (c,ii) str = (c ++ str,ii)

src/compiler/GF/Grammar/Grammar.hs

@@ -190,9 +190,9 @@ allExtendsPlus gr i =
   where
     exts m = extends m ++ [j | MTInstance (j,_) <- [mtype m]]
 
--- | initial search path: the nonqualified dependencies
+-- -- | initial search path: the nonqualified dependencies
-searchPathModule :: ModuleInfo -> [ModuleName]
+-- searchPathModule :: ModuleInfo -> [ModuleName]
-searchPathModule m = [i | OSimple i <- depPathModule m]
+-- searchPathModule m = [i | OSimple i <- depPathModule m]
 
 prependModule :: Grammar -> Module -> Grammar
 prependModule (MGrammar mm ms) im@(i,m) = MGrammar (Map.insert i m mm) (im:ms)

src/compiler/GF/Grammar/PatternMatch.hs

@@ -201,7 +201,7 @@ varsOfPatt p = case p of
   PR r    -> concat $ map (varsOfPatt . snd) r
   PT _ q -> varsOfPatt q
   _ -> []
--}
+
 -- | to search matching parameter combinations in tables
 isMatchingForms :: [Patt] -> [Term] -> Bool
 isMatchingForms ps ts = all match (zip ps ts') where
@@ -209,3 +209,4 @@ isMatchingForms ps ts = all match (zip ps ts') where
   match _ = True
   ts' = map appForm ts
 
+-}

src/compiler/GF/JavaScript/PrintJS.hs

@@ -22,7 +22,7 @@ render d = rend 0 (map ($ "") $ d []) "" where
     t:ts@(t':_) | not (spaceBefore t') -> showString t . rend i ts
     t:ts -> space t . rend i ts
     []   -> id
-  new i   = showChar '\n' . replicateS (2*i) (showChar ' ') . dropWhile isSpace
+--new i   = showChar '\n' . replicateS (2*i) (showChar ' ') . dropWhile isSpace
   space t = showString t . (\s -> if null s then "" else (' ':s))
 
 spaceAfter :: String -> Bool
@@ -39,10 +39,10 @@ concatS = foldr (.) id
 
 concatD :: [Doc] -> Doc
 concatD = foldr (.) id
-
+{-
 replicateS :: Int -> ShowS -> ShowS
 replicateS n f = concatS (replicate n f)
-
+-}
 -- the printer class does the job
 class Print a where
   prt :: Int -> a -> Doc

src/compiler/GF/Server.hs

@@ -142,7 +142,7 @@ handle logLn documentroot state0 cache execute1 stateVar
       _ -> return (resp501 $ "method "++method)
   where
     logPutStrLn msg = liftIO $ logLn msg
-    debug msg = logPutStrLn msg
+--  debug msg = logPutStrLn msg
 
     addDate m =
       do t <- getCurrentTime
@@ -371,7 +371,7 @@ ok200' t     = Response 200 [t,xo]
 json200 x    = json200' id x
 json200' f   = ok200' jsonUTF8 . encodeString . f . encode
 jsonp200' f  = ok200' jsonpUTF8 . encodeString . f . encode
-html200      = ok200' htmlUTF8 . encodeString
+--html200    = ok200' htmlUTF8 . encodeString
 resp204      = Response 204 [xo] "" -- no content
 resp301 url  = Response 301 [plain,xo,location url] $
                "Moved permanently to "++url
@@ -389,7 +389,7 @@ plain = ct "text/plain" ""
 plainUTF8 = ct "text/plain" csutf8
 jsonUTF8 = ct "application/json" csutf8 -- http://www.ietf.org/rfc/rfc4627.txt
 jsonpUTF8 = ct "application/javascript" csutf8
-htmlUTF8 = ct "text/html" csutf8
+--htmlUTF8 = ct "text/html" csutf8
 
 ct t cs = ("Content-Type",t++cs)
 csutf8 = "; charset=UTF-8"

src/compiler/GF/Speech/FiniteState.hs

@@ -36,7 +36,7 @@ module GF.Speech.FiniteState (FA(..), State, NFA, DFA,
 
 import Data.List
 import Data.Maybe 
-import Data.Map (Map)
+--import Data.Map (Map)
 import qualified Data.Map as Map
 import Data.Set (Set)
 import qualified Data.Set as Set
@@ -246,8 +246,8 @@ fixIncoming cs c@((n,()),es) = (cs'', ((n,Nothing),es'):newContexts)
 		    ++ [ (y,x,()) | (f,_,l') <- cyc, l == l', (y,_) <- newNodes]
 	newContexts = [ (v, to v) | v <- newNodes ]
 
-alphabet :: Eq b => Graph n a (Maybe b) -> [b]
+--alphabet :: Eq b => Graph n a (Maybe b) -> [b]
-alphabet = nub . catMaybes . map edgeLabel . edges
+--alphabet = nub . catMaybes . map edgeLabel . edges
 
 determinize :: Ord a => NFA a -> DFA a
 determinize (FA g s f) = let (ns,es) = h (Set.singleton start) Set.empty Set.empty
@@ -309,8 +309,8 @@ dfa2nfa = mapTransitions Just
 prFAGraphviz :: (Eq n,Show n) => FA n String String -> String
 prFAGraphviz  = Dot.prGraphviz . faToGraphviz
 
-prFAGraphviz_ :: (Eq n,Show n,Show a, Show b) => FA n a b -> String
+--prFAGraphviz_ :: (Eq n,Show n,Show a, Show b) => FA n a b -> String
-prFAGraphviz_  = Dot.prGraphviz . faToGraphviz . mapStates show . mapTransitions show
+--prFAGraphviz_  = Dot.prGraphviz . faToGraphviz . mapStates show . mapTransitions show
 
 faToGraphviz :: (Eq n,Show n) => FA n String String -> Dot.Graph
 faToGraphviz (FA (Graph _ ns es) s f) 
@@ -325,5 +325,5 @@ faToGraphviz (FA (Graph _ ns es) s f)
 -- * Utilities
 --
 
-lookups :: Ord k => [k] -> Map k a -> [a]
+--lookups :: Ord k => [k] -> Map k a -> [a]
-lookups xs m = mapMaybe (flip Map.lookup m) xs
+--lookups xs m = mapMaybe (flip Map.lookup m) xs

src/compiler/GF/Speech/GSL.hs

@@ -78,8 +78,8 @@ keepSymbol _ = True
 showToken :: Token -> Doc
 showToken = pp . map toLower
 
-isPunct :: Char -> Bool
+--isPunct :: Char -> Bool
-isPunct c = c `elem` "-_.:;.,?!()[]{}"
+--isPunct c = c `elem` "-_.:;.,?!()[]{}"
 
 comment :: String -> Doc
 comment s = ";" <+> s

src/compiler/GF/Speech/SLF.hs

@@ -51,7 +51,7 @@ mkFAs pgf cnc = (slfStyleFA main, [(c,slfStyleFA n) | (c,n) <- subs])
 slfStyleFA :: Eq a => DFA a -> FA State (Maybe a) ()
 slfStyleFA = renameStates [0..] . removeTrivialEmptyNodes . oneFinalState Nothing ()
              . moveLabelsToNodes . dfa2nfa
-
+{-
 -- | Give sequential names to subnetworks.
 renameSubs :: MFA -> MFA
 renameSubs (MFA start subs) = MFA (newName start) subs'
@@ -59,7 +59,7 @@ renameSubs (MFA start subs) = MFA (newName start) subs'
         newName s = lookup' s newNames
         subs' = [(newName s,renameLabels n) | (s,n) <- subs]
         renameLabels = mapTransitions (mapSymbol newName id)
-
+-}
 --
 -- * SLF graphviz printing (without sub-networks)
 --

src/compiler/GF/Speech/SRG.hs

@@ -37,7 +37,7 @@ import qualified Data.Map as Map
 import Data.Set (Set)
 import qualified Data.Set as Set
 
-import Debug.Trace
+--import Debug.Trace
 
 data SRG = SRG { srgName :: String    -- ^ grammar name
 		 , srgStartCat :: Cat     -- ^ start category name
@@ -88,13 +88,13 @@ setDefaultCFGTransform opts t b = setCFGTransform t b `addOptions` opts
 
 maybeTransform :: Options -> CFGTransform -> (CFG -> CFG) -> (CFG -> CFG)
 maybeTransform opts t f = if cfgTransform opts t then f else id
-
+{-
 traceStats s g = trace ("---- " ++ s ++ ": " ++ stats g {- ++ "\n" ++ prCFRules g ++ "----" -}) g
 
 stats g = "Categories: " ++ show (countCats g)
           ++ ", External categories: " ++ show (Set.size (cfgExternalCats g))
           ++ ", Rules: " ++ show (countRules g)
-
+-}
 makeNonRecursiveSRG :: Options 
                     -> PGF
                     -> CId -- ^ Concrete syntax name.

src/compiler/GF/Speech/SRGS_ABNF.hs

@@ -99,10 +99,10 @@ tag (Just fmt) t =
 
 isPunct :: Char -> Bool
 isPunct c = c `elem` "-_.;.,?!"
-
+{-
 comment :: String -> Doc
 comment s = "//" <+> s
-
+-}
 alts :: [Doc] -> Doc
 alts = fsep . prepunctuate ("| ")
 

src/compiler/GF/Speech/VoiceXML.hs

@@ -151,13 +151,13 @@ prompt = Tag "prompt" []
 
 promptString :: String -> XML
 promptString p = prompt [Data p]
-
+{-
 reprompt :: XML
 reprompt = ETag "reprompt" []
-
+-}
 assign :: String -> String -> XML
 assign n e = ETag "assign" [("name",n),("expr",e)]
-
+{-
 value :: String -> XML
 value expr = ETag "value" [("expr",expr)]
 
@@ -174,7 +174,7 @@ cond ((c,b):rest) els = Tag "if" [("cond",c)] (b ++ es)
 
 goto_item :: String -> XML
 goto_item nextitem = ETag "goto" [("nextitem",nextitem)]
-
+-}
 return_ :: [String] -> XML
 return_ names = ETag "return" [("namelist", unwords names)]
 
@@ -183,7 +183,7 @@ block = Tag "block" []
 
 blockCond :: String -> [XML] -> XML
 blockCond cond = Tag "block" [("cond", cond)]
-
+{-
 throw :: String -> String -> XML
 throw event msg = Tag "throw" [("event",event),("message",msg)] []
 
@@ -192,20 +192,20 @@ nomatch = Tag "nomatch" []
 
 help :: [XML] -> XML
 help = Tag "help" []
-
+-}
 param :: String -> String -> XML
 param name expr = ETag "param" [("name",name),("expr",expr)]
 
 var :: String -> Maybe String -> XML
 var name expr = ETag "var" ([("name",name)]++e)
   where e = maybe [] ((:[]) . (,) "expr") expr
-
+{-
 script :: String -> XML
 script s = Tag "script" [] [CData s]
 
 scriptURI :: String -> XML
 scriptURI uri = Tag "script" [("uri", uri)] []
-
+-}
 --
 -- * ECMAScript stuff
 --

src/compiler/GF/Text/Clitics.hs

@@ -35,6 +35,6 @@ getCliticsText isLex rclitics =
 
 -- example
 
-getClitics1 = getClitics exlex1 exclits1
+--getClitics1 = getClitics exlex1 exclits1
-exlex1   = flip elem ["auto", "naise", "rahan","maa","maahan","maahankaan"]
+--exlex1   = flip elem ["auto", "naise", "rahan","maa","maahan","maahankaan"]
-exclits1 = map reverse ["ni","ko","han","pas","nsa","kin","kaan"]
+--exclits1 = map reverse ["ni","ko","han","pas","nsa","kin","kaan"]

src/example-based/ExampleDemo.hs

@@ -92,7 +92,7 @@ llin :: Environ -> Expr -> Expr
 llin env expr = 
      let 
          (id,args) = fromJust $ unApp expr
-         cexpr = fromJust $ Map.lookup id (getConcMap env)
+       --cexpr = fromJust $ Map.lookup id (getConcMap env)
      in 
          if any isMeta args 
               then let 
@@ -170,7 +170,7 @@ embedInStart fss cs =
 
 
 -----------------------------------------------
-
+{-
 updateConcMap :: Environ -> MyFunc -> Expr -> Environ
 updateConcMap env myf expr = 
      Env (getTypeMap env) (Map.insert myf expr (getConcMap env)) (getSigs env) (getAll env)
@@ -196,14 +196,14 @@ updateEnv env myf myt expr =
        newInterInstr = 
          maybe (Map.insert myt [myf] ii) (\x -> Map.insert myt (myf:x) ii) $ Map.lookup myt ii
       in Env (getTypeMap env) (Map.insert nn expr (getConcMap env)) newInterInstr (getAll env)
-
+-}
 
 mkSigs :: [FuncWithArg] -> Map.Map MyType [FuncWithArg]
 mkSigs fss = Map.fromListWith (++) $ zip (map getType fss) (map (\x -> [x]) fss)
 
 
 
-------------------------------------
+{------------------------------------
 lang :: String 
 lang = "Eng"
 
@@ -214,7 +214,7 @@ parseLang = fromJust $ readLanguage "ParseEng"
 
 parsePGFfile :: String
 parsePGFfile = "ParseEngAbs.pgf"
-------------------------------------
+------------------------------------}
 
 
 
@@ -307,7 +307,7 @@ debugReplaceConc expr i e =
                                          in (mkApp cid (map  fst repargs), or $ map snd repargs)) $ unApp e_  
  
 
-
+{-
 -- replaceArgs : Original expression to parse (from abstract syntax) -> Concrete expression (parsed) 
 replaceArgs :: Expr -> Expr -> Environ -> Maybe Expr
 replaceArgs aexpr cexpr env =
@@ -352,7 +352,7 @@ simpleReplace :: String -> String
 simpleReplace [] = []
 simpleReplace ('?':xs) = 'o' : simpleReplace xs
 simpleReplace (x:xs) = x : simpleReplace xs
-
+-}
 
 isMeta :: Expr -> Bool
 isMeta = isJust.unMeta 
@@ -368,12 +368,12 @@ mkFuncWithArg ((c1,c2),cids) = FuncWithArg c1 c2 cids
 
 initial :: TypeMap -> ConcMap -> [FuncWithArg] -> [FuncWithArg] -> Environ
 initial tm cm fss allfs = Env tm cm (mkSigs fss) allfs
-
+{-
 testInit :: [FuncWithArg] -> Environ
 testInit allfs = initial lTypes Map.empty [] allfs
 
 lTypes = Map.fromList [(mkCId "Comment", mkCId "S"),(mkCId "Item", mkCId "NP"), (mkCId "Kind", mkCId "CN"), (mkCId "Quality", mkCId "AP")]
-
+-}
 startCateg = mkCId "Comment"
 -- question about either to give the startcat or not ...
 

src/example-based/ExampleService.hs

@@ -71,11 +71,11 @@ doTestFunction cwd cache environ =
 getCId :: String -> CGI CId
 getCId name = maybe err return =<< fmap readCId (getInp name)
   where err = throwCGIError 400 ("Bad "++name) []
-
+{-
 getLimit :: CGI Int
 getLimit = maybe err return =<< readInput "limit"
   where err = throwCGIError 400 "Missing/bad limit" []
-
+-}
 
 readParsePGF cwd cache =
     do parsepgf <- getInp "parser"

src/runtime/haskell/PGF/Forest.hs

@@ -71,7 +71,7 @@ bracketedTokn dp f@(Forest abs cnc forest root) =
                         in (ct,fid',fun,es,(map getVar hypos,lin))
         Nothing      -> error ("wrong forest id " ++ show fid)
       where
-        descend forest (PApply funid args) = let (CncFun fun lins) = cncfuns cnc ! funid
+        descend forest (PApply funid args) = let (CncFun fun _lins) = cncfuns cnc ! funid
                                                  cat = case isLindefCId fun of
                                                          Just cat -> cat
                                                          Nothing  -> case Map.lookup fun (funs abs) of
@@ -132,7 +132,7 @@ getAbsTrees (Forest abs cnc forest root) arg@(PArg _ fid) ty dp =
       | otherwise           = do fid0 <- get
                                  put fid
                                  x <- foldForest (\funid args trees ->
-                                                  do let CncFun fn lins = cncfuns cnc ! funid
+                                                  do let CncFun fn _lins = cncfuns cnc ! funid
                                                      case isLindefCId fn of
                                                        Just _  -> do arg <- go (Set.insert fid rec_) scope mb_tty (head args)
                                                                      return (mkAbs arg)

src/runtime/haskell/PGF/Linearize.hs

@@ -124,5 +124,5 @@ linTree pgf cnc e = nub (map snd (lin Nothing 0 e [] [] e []))
                                   def (Just (cat,fid)) n_fid e0 ys xs s
     def Nothing          n_fid e0 ys xs s = []
 
-amapWithIndex :: (IArray a e1, IArray a e2, Ix i) => (i -> e1 -> e2) -> a i e1 -> a i e2
+--amapWithIndex :: (IArray a e1, IArray a e2, Ix i) => (i -> e1 -> e2) -> a i e1 -> a i e2
-amapWithIndex f arr = listArray (bounds arr) (map (uncurry f) (assocs arr))
+--amapWithIndex f arr = listArray (bounds arr) (map (uncurry f) (assocs arr))

src/runtime/haskell/PGF/Macros.hs

@@ -231,11 +231,11 @@ computeSeq filter seq args = concatMap compute seq
       | otherwise   = arg_lin
       where
         arg_lin                          = lin ! r
-        (ct@(cat,fid),_,fun,es,(xs,lin)) = args !! d
+        (ct@(cat,fid),_,fun,es,(_xs,lin)) = args !! d
 
     getVar d r = [LeafKS (showCId (xs !! r))]
       where
-        (ct,_,fun,es,(xs,lin)) = args !! d
+        (_ct,_,_fun,_es,(xs,_lin)) = args !! d
 
 flattenBracketedString :: BracketedString -> [String]
 flattenBracketedString (Leaf w)              = [w]

src/runtime/haskell/PGF/OldBinary.hs

@@ -159,8 +159,8 @@ getArray get1 = toArray `fmap` getList' get1
 toArray (n,xs) = listArray (0::Int,n-1) xs
 listToArray xs = toArray (length xs,xs)
 
-getArray2 :: (IArray a1 (a2 Int e), IArray a2 e) => Get e -> Get (a1 Int (a2 Int e))
+--getArray2 :: (IArray a1 (a2 Int e), IArray a2 e) => Get e -> Get (a1 Int (a2 Int e))
-getArray2 get1 = getArray (getArray get1)
+--getArray2 get1 = getArray (getArray get1)
 
 getList get1 = snd `fmap` getList' get1
 

src/runtime/haskell/PGF/Probabilistic.hs

@@ -210,7 +210,7 @@ mkProbDefs pgf =
                               then closure k deps2 vs2 vs3
                               else closure k deps2 ((src,dst') : vs2) vs3
                        else closure k (dep2 : deps2) vs2 vs3
-
+{-
         mkNewSig src =
           DTyp (mkArgs 0 0 [] src) cidFloat []
           where
@@ -219,7 +219,7 @@ mkProbDefs pgf =
                | i == k    = let ty = DTyp [] c (map (normalForm sig k env) es)
                              in (Explicit,wildCId,ty) : mkArgs (k+1) (l+1) (VGen l [] : env) src
                | otherwise = mkArgs (k+1) l (VMeta 0 env [] : env) src
-
+-}
 type CState = (Int,Map.Map CId [Equation])
 
 computeConstrs :: PGF -> CState -> [(CId,[Patt],[Expr])] -> (CState,[[CId]])
@@ -263,7 +263,7 @@ computeConstrs pgf st fns =
       where
         addArgs (cn,fns) = addArg (length args) cn [] fns
           where
-            Just (ty@(DTyp args _ es),_,_,_) = Map.lookup cn (funs (abstract pgf))
+            Just (DTyp args _ _es,_,_,_) = Map.lookup cn (funs (abstract pgf))
 
         addArg 0 cn ps fns = [(PApp cn (reverse ps),fns)]
         addArg n cn ps fns = concat [addArg (n-1) cn (arg:ps) fns' | (arg,fns') <- computeConstr fns]

src/runtime/haskell/PGF/SortTop.hs

@@ -55,7 +55,7 @@ typesInterm abs fset =
                                      in (x,c)) fset
               in Map.fromList $ Set.toList fsetTypes             
 
-
+{-
 takeArgs :: Map.Map CId CId -> Map.Map CId Expr -> CId -> Expr
 takeArgs mtypes mexpr ty = 
      let xarg = head $ Map.keys $ Map.filter (==ty) mtypes
@@ -63,7 +63,7 @@ takeArgs mtypes mexpr ty =
 
 doesReturnCat :: Type -> CId -> Bool
 doesReturnCat (DTyp _ c _) cat = c == cat                                  
-                         
+-}                         
 returnCat :: Abstr -> CId -> CId 
 returnCat abs cid = 
       let p = Map.lookup cid $ funs abs           

src/runtime/haskell/PGF/TypeCheck.hs

@@ -600,6 +600,7 @@ generateForForest :: (Scope -> TType -> TcM FId Expr) -> Expr -> TcM FId Expr
 generateForForest prove e = do
 --  fillinVariables
   refineExpr e
+{-
   where
     fillinVariables = do
       fvs <- TcM (\abstr k h ms -> k [(i,s,scope,tty,cs) | (i,MUnbound s scope tty cs) <- IntMap.toList ms] ms)
@@ -614,6 +615,7 @@ generateForForest prove e = do
                                                                     sequence_ [c e | c <- cs]
                                                                     fillinVariables
                                                                 ) abstr k h ms s)
+-}
 
 -----------------------------------------------------
 -- evalType

src/server/PGFService.hs

@@ -37,7 +37,7 @@ import Control.Monad
 import Control.Monad.State(State,evalState,get,put)
 import Control.Monad.Catch(bracket_)
 import Data.Char
-import Data.Function (on)
+--import Data.Function (on)
 import Data.List (sortBy,intersperse,mapAccumL,nub,isSuffixOf,nubBy)
 import qualified Data.Map as Map
 import Data.Maybe
@@ -678,7 +678,7 @@ completionInfo pgf token pstate =
       Just typ ->
         makeObj [ {-"fid".=funid,-} "fun".=cid, "hyps".=hyps', "cat".=cat, "seq".=seq ]
         where
-          (hyps,cat,es) = PGF.unType typ
+          (hyps,cat,_es) = PGF.unType typ
           hyps' = [ PGF.showType [] typ | (_,_,typ) <- hyps ]
       Nothing -> makeObj [ "error".=("Function "++show cid++" not found") ] -- shouldn't happen
 
@@ -948,10 +948,10 @@ instance JSON PGF.BracketedString where
     showJSON (PGF.Leaf s) = makeObj ["token".=s]
 
 -- * PGF utilities
-
+{-
 cat :: PGF -> Maybe PGF.Type -> PGF.Type
 cat pgf mcat = fromMaybe (PGF.startCat pgf) mcat
-
+-}
 parse' :: PGF -> String -> Maybe PGF.Type -> Maybe PGF.Language -> [(PGF.Language,PGF.ParseOutput,PGF.BracketedString)]
 parse' pgf input mcat mfrom = 
    [(from,po,bs) | from <- froms, (po,bs) <- [PGF.parse_ pgf from cat Nothing input]]
@@ -969,7 +969,7 @@ complete' pgf from typ mlimit input =
        then (bs, unwords (if null prefix then ws' else ws'++[prefix]), Map.empty)
        else (bs, prefix, PGF.getCompletions ps prefix)
   where
-    order = sortBy (compare `on` map toLower)
+  --order = sortBy (compare `on` map toLower)
 
     tokensAndPrefix :: String -> ([String],String)
     tokensAndPrefix s | not (null s) && isSpace (last s) = (ws, "")