diff --git a/src/binary/Data/Binary/Put.hs b/src/binary/Data/Binary/Put.hs index 070f5ab40..189cf806f 100644 --- a/src/binary/Data/Binary/Put.hs +++ b/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 diff --git a/src/compiler/GF/Command/Interpreter.hs b/src/compiler/GF/Command/Interpreter.hs index b01dc1fc5..abd06c3a1 100644 --- a/src/compiler/GF/Command/Interpreter.hs +++ 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 diff --git a/src/compiler/GF/Command/TreeOperations.hs b/src/compiler/GF/Command/TreeOperations.hs index b06da6cff..936b6c143 100644 --- a/src/compiler/GF/Command/TreeOperations.hs +++ b/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 diff --git a/src/compiler/GF/Compile/Compute/ConcreteNew.hs b/src/compiler/GF/Compile/Compute/ConcreteNew.hs index 5183ebf32..54e57478e 100644 --- a/src/compiler/GF/Compile/Compute/ConcreteNew.hs +++ b/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 diff --git a/src/compiler/GF/Compile/Compute/Predef.hs b/src/compiler/GF/Compile/Compute/Predef.hs index ab74f1f63..0900f3665 100644 --- a/src/compiler/GF/Compile/Compute/Predef.hs +++ b/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 +-} \ No newline at end of file diff --git a/src/compiler/GF/Compile/ConcreteToHaskell.hs b/src/compiler/GF/Compile/ConcreteToHaskell.hs index 6dc572b39..ad4775697 100644 --- a/src/compiler/GF/Compile/ConcreteToHaskell.hs +++ b/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))) diff --git a/src/compiler/GF/Compile/GenerateBC.hs b/src/compiler/GF/Compile/GenerateBC.hs index 35ae11f02..3e13ea9e8 100644 --- a/src/compiler/GF/Compile/GenerateBC.hs +++ b/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 = diff --git a/src/compiler/GF/Compile/GrammarToPGF.hs b/src/compiler/GF/Compile/GrammarToPGF.hs index 39202de4c..cd2e6b8ce 100644 --- a/src/compiler/GF/Compile/GrammarToPGF.hs +++ b/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 - (index',cats) = mkCncCats (e+1) cdefs + let cc@(C.CncCat _s e _) = pgfCncCat gr lincat index + (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] diff --git a/src/compiler/GF/Compile/PGFtoHaskell.hs b/src/compiler/GF/Compile/PGFtoHaskell.hs index 749ad24bc..f4cf66219 100644 --- a/src/compiler/GF/Compile/PGFtoHaskell.hs +++ b/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 diff --git a/src/compiler/GF/Compile/PGFtoJS.hs b/src/compiler/GF/Compile/PGFtoJS.hs index 1d53cbc3b..050a3f658 100644 --- a/src/compiler/GF/Compile/PGFtoJS.hs +++ b/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" diff --git a/src/compiler/GF/Compile/TypeCheck/RConcrete.hs b/src/compiler/GF/Compile/TypeCheck/RConcrete.hs index 9d987d965..8913f7c5d 100644 --- a/src/compiler/GF/Compile/TypeCheck/RConcrete.hs +++ b/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 diff --git a/src/compiler/GF/Compile/TypeCheck/TC.hs b/src/compiler/GF/Compile/TypeCheck/TC.hs index c5924d1bc..abcb24617 100644 --- a/src/compiler/GF/Compile/TypeCheck/TC.hs +++ b/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 = (0,[],[]) +--emptyTCEnv :: TCEnv +--emptyTCEnv = (0,[],[]) whnf :: Val -> Err Val whnf v = ---- errIn ("whnf" +++ prt v) $ ---- debug diff --git a/src/compiler/GF/Compiler.hs b/src/compiler/GF/Compiler.hs index cd27c487b..79ed66e7c 100644 --- a/src/compiler/GF/Compiler.hs +++ b/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 diff --git a/src/compiler/GF/Data/Relation.hs b/src/compiler/GF/Data/Relation.hs index 195faf96f..5a3e80e6f 100644 --- a/src/compiler/GF/Data/Relation.hs +++ b/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 x r = maybe Set.empty snd $ Map.lookup x r \ No newline at end of file +--outgoing :: Ord a => a -> Rel' a -> Set a +--outgoing x r = maybe Set.empty snd $ Map.lookup x r \ No newline at end of file diff --git a/src/compiler/GF/Data/Str.hs b/src/compiler/GF/Data/Str.hs index 6f65764c7..0c9ab05ec 100644 --- a/src/compiler/GF/Data/Str.hs +++ b/src/compiler/GF/Data/Str.hs @@ -20,8 +20,8 @@ module GF.Data.Str ( allItems ) where -import GF.Data.Operations -import Data.List (isPrefixOf, isSuffixOf, intersperse) +import GF.Data.Operations(prQuotedString) +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 diff --git a/src/compiler/GF/Grammar/Analyse.hs b/src/compiler/GF/Grammar/Analyse.hs index 5883ad4ff..4c8f2020f 100644 --- a/src/compiler/GF/Grammar/Analyse.hs +++ b/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 diff --git a/src/compiler/GF/Grammar/CFG.hs b/src/compiler/GF/Grammar/CFG.hs index 93bce2aad..9f4dd49a9 100644 --- a/src/compiler/GF/Grammar/CFG.hs +++ b/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 diff --git a/src/compiler/GF/Grammar/EBNF.hs b/src/compiler/GF/Grammar/EBNF.hs index 50a5ff90a..8d0addfd7 100644 --- a/src/compiler/GF/Grammar/EBNF.hs +++ b/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) diff --git a/src/compiler/GF/Grammar/Grammar.hs b/src/compiler/GF/Grammar/Grammar.hs index 34b8a1bdf..6f254e7d3 100644 --- a/src/compiler/GF/Grammar/Grammar.hs +++ b/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 -searchPathModule :: ModuleInfo -> [ModuleName] -searchPathModule m = [i | OSimple i <- depPathModule m] +-- -- | initial search path: the nonqualified dependencies +-- searchPathModule :: ModuleInfo -> [ModuleName] +-- 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) diff --git a/src/compiler/GF/Grammar/PatternMatch.hs b/src/compiler/GF/Grammar/PatternMatch.hs index 48cb9bd3f..845867459 100644 --- a/src/compiler/GF/Grammar/PatternMatch.hs +++ b/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 +-} \ No newline at end of file diff --git a/src/compiler/GF/JavaScript/PrintJS.hs b/src/compiler/GF/JavaScript/PrintJS.hs index 1e721e353..4a8976138 100644 --- a/src/compiler/GF/JavaScript/PrintJS.hs +++ b/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 diff --git a/src/compiler/GF/Server.hs b/src/compiler/GF/Server.hs index c2b163d44..3a193cc33 100644 --- a/src/compiler/GF/Server.hs +++ b/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" diff --git a/src/compiler/GF/Speech/FiniteState.hs b/src/compiler/GF/Speech/FiniteState.hs index 4eaf3873a..cb5247755 100644 --- a/src/compiler/GF/Speech/FiniteState.hs +++ b/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 = nub . catMaybes . map edgeLabel . edges +--alphabet :: Eq b => Graph n a (Maybe b) -> [b] +--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_ = Dot.prGraphviz . faToGraphviz . mapStates show . mapTransitions show +--prFAGraphviz_ :: (Eq n,Show n,Show a, Show b) => FA n a b -> String +--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 xs m = mapMaybe (flip Map.lookup m) xs +--lookups :: Ord k => [k] -> Map k a -> [a] +--lookups xs m = mapMaybe (flip Map.lookup m) xs diff --git a/src/compiler/GF/Speech/GSL.hs b/src/compiler/GF/Speech/GSL.hs index ca49afb61..d9d6af0cc 100644 --- a/src/compiler/GF/Speech/GSL.hs +++ b/src/compiler/GF/Speech/GSL.hs @@ -78,8 +78,8 @@ keepSymbol _ = True showToken :: Token -> Doc showToken = pp . map toLower -isPunct :: Char -> Bool -isPunct c = c `elem` "-_.:;.,?!()[]{}" +--isPunct :: Char -> Bool +--isPunct c = c `elem` "-_.:;.,?!()[]{}" comment :: String -> Doc comment s = ";" <+> s diff --git a/src/compiler/GF/Speech/SLF.hs b/src/compiler/GF/Speech/SLF.hs index 1992baaec..16f8f0461 100644 --- a/src/compiler/GF/Speech/SLF.hs +++ b/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) -- diff --git a/src/compiler/GF/Speech/SRG.hs b/src/compiler/GF/Speech/SRG.hs index d5bedc797..a0a616561 100644 --- a/src/compiler/GF/Speech/SRG.hs +++ b/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. diff --git a/src/compiler/GF/Speech/SRGS_ABNF.hs b/src/compiler/GF/Speech/SRGS_ABNF.hs index f5e163951..75d206a0c 100644 --- a/src/compiler/GF/Speech/SRGS_ABNF.hs +++ b/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 ("| ") diff --git a/src/compiler/GF/Speech/VoiceXML.hs b/src/compiler/GF/Speech/VoiceXML.hs index 79c904f49..84264c4d7 100644 --- a/src/compiler/GF/Speech/VoiceXML.hs +++ b/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 -- diff --git a/src/compiler/GF/Text/Clitics.hs b/src/compiler/GF/Text/Clitics.hs index 849deb94e..4374b2f31 100644 --- a/src/compiler/GF/Text/Clitics.hs +++ b/src/compiler/GF/Text/Clitics.hs @@ -35,6 +35,6 @@ getCliticsText isLex rclitics = -- example -getClitics1 = getClitics exlex1 exclits1 -exlex1 = flip elem ["auto", "naise", "rahan","maa","maahan","maahankaan"] -exclits1 = map reverse ["ni","ko","han","pas","nsa","kin","kaan"] +--getClitics1 = getClitics exlex1 exclits1 +--exlex1 = flip elem ["auto", "naise", "rahan","maa","maahan","maahankaan"] +--exclits1 = map reverse ["ni","ko","han","pas","nsa","kin","kaan"] diff --git a/src/example-based/ExampleDemo.hs b/src/example-based/ExampleDemo.hs index 7b411001b..fe4eb501d 100644 --- a/src/example-based/ExampleDemo.hs +++ b/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 ... diff --git a/src/example-based/ExampleService.hs b/src/example-based/ExampleService.hs index 28d3731d4..e6312bf96 100644 --- a/src/example-based/ExampleService.hs +++ b/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" diff --git a/src/runtime/haskell/PGF/Forest.hs b/src/runtime/haskell/PGF/Forest.hs index bb4ba29af..2a680b7c9 100644 --- a/src/runtime/haskell/PGF/Forest.hs +++ b/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) diff --git a/src/runtime/haskell/PGF/Linearize.hs b/src/runtime/haskell/PGF/Linearize.hs index 2393010b7..e3e8d92db 100644 --- a/src/runtime/haskell/PGF/Linearize.hs +++ b/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 f arr = listArray (bounds arr) (map (uncurry f) (assocs arr)) +--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)) diff --git a/src/runtime/haskell/PGF/Macros.hs b/src/runtime/haskell/PGF/Macros.hs index 42d16683a..de175616c 100644 --- a/src/runtime/haskell/PGF/Macros.hs +++ b/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] diff --git a/src/runtime/haskell/PGF/OldBinary.hs b/src/runtime/haskell/PGF/OldBinary.hs index 9a65b0fa6..c727589f5 100644 --- a/src/runtime/haskell/PGF/OldBinary.hs +++ b/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 get1 = getArray (getArray get1) +--getArray2 :: (IArray a1 (a2 Int e), IArray a2 e) => Get e -> Get (a1 Int (a2 Int e)) +--getArray2 get1 = getArray (getArray get1) getList get1 = snd `fmap` getList' get1 diff --git a/src/runtime/haskell/PGF/Probabilistic.hs b/src/runtime/haskell/PGF/Probabilistic.hs index 555ae0ce9..780e1c12f 100644 --- a/src/runtime/haskell/PGF/Probabilistic.hs +++ b/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] diff --git a/src/runtime/haskell/PGF/SortTop.hs b/src/runtime/haskell/PGF/SortTop.hs index f3747b805..c31b32e91 100644 --- a/src/runtime/haskell/PGF/SortTop.hs +++ b/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 diff --git a/src/runtime/haskell/PGF/TypeCheck.hs b/src/runtime/haskell/PGF/TypeCheck.hs index 8860ed17b..3c2580d59 100644 --- a/src/runtime/haskell/PGF/TypeCheck.hs +++ b/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 diff --git a/src/server/PGFService.hs b/src/server/PGFService.hs index 3d9b2838a..5889c07b8 100644 --- a/src/server/PGFService.hs +++ b/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, "")