diff options
| author | krangelov <kr.angelov@gmail.com> | 2019-09-20 16:15:28 +0200 |
|---|---|---|
| committer | krangelov <kr.angelov@gmail.com> | 2019-09-20 16:15:28 +0200 |
| commit | 30eef61f0a400d6b9ec77721620e13b8132a9c2c (patch) | |
| tree | 2d7db8cc4ff7fc0bc781e3dcb202d493d4706827 /src/compiler/GF/Compile | |
| parent | 29662350dcdb350479576dfa099037fd71debc1a (diff) | |
more dead code
Diffstat (limited to 'src/compiler/GF/Compile')
| -rw-r--r-- | src/compiler/GF/Compile/CheckGrammar.hs | 2 | ||||
| -rw-r--r-- | src/compiler/GF/Compile/Compute/AppPredefined.hs | 143 | ||||
| -rw-r--r-- | src/compiler/GF/Compile/Compute/ConcreteNew.hs | 4 | ||||
| -rw-r--r-- | src/compiler/GF/Compile/Update.hs | 5 |
4 files changed, 6 insertions, 148 deletions
diff --git a/src/compiler/GF/Compile/CheckGrammar.hs b/src/compiler/GF/Compile/CheckGrammar.hs index c0d300e31..24582bba2 100644 --- a/src/compiler/GF/Compile/CheckGrammar.hs +++ b/src/compiler/GF/Compile/CheckGrammar.hs @@ -270,7 +270,7 @@ checkInfo opts cwd sgr (m,mo) c info = checkInModule cwd mo NoLoc empty $ do chIn loc cat = checkInModule cwd mo loc ("Happened in" <+> cat <+> c) mkPar (f,co) = do - vs <- liftM combinations $ mapM (\(_,_,ty) -> allParamValues gr ty) co + vs <- liftM sequence $ mapM (\(_,_,ty) -> allParamValues gr ty) co return $ map (mkApp (QC (m,f))) vs checkUniq xss = case xss of diff --git a/src/compiler/GF/Compile/Compute/AppPredefined.hs b/src/compiler/GF/Compile/Compute/AppPredefined.hs deleted file mode 100644 index 0869cedee..000000000 --- a/src/compiler/GF/Compile/Compute/AppPredefined.hs +++ /dev/null @@ -1,143 +0,0 @@ ----------------------------------------------------------------------- --- | --- Module : AppPredefined --- Maintainer : AR --- Stability : (stable) --- Portability : (portable) --- --- > CVS $Date: 2005/10/06 14:21:34 $ --- > CVS $Author: aarne $ --- > CVS $Revision: 1.13 $ --- --- Predefined function type signatures and definitions. ------------------------------------------------------------------------------ - -module GF.Compile.Compute.AppPredefined ({- - isInPredefined, typPredefined, arrityPredefined, predefModInfo, appPredefined-} - ) where -{- -import GF.Compile.TypeCheck.Primitives -import GF.Infra.Option -import GF.Data.Operations -import GF.Grammar -import GF.Grammar.Predef - -import qualified Data.Map as Map -import GF.Text.Pretty -import Data.Char (isUpper,toUpper,toLower) - --- predefined function type signatures and definitions. AR 12/3/2003. - -isInPredefined :: Ident -> Bool -isInPredefined f = Map.member f primitives - -arrityPredefined :: Ident -> Maybe Int -arrityPredefined f = do ty <- typPredefined f - let (ctxt,_) = typeFormCnc ty - return (length ctxt) - -predefModInfo :: SourceModInfo -predefModInfo = ModInfo MTResource MSComplete noOptions [] Nothing [] [] "Predef.gf" Nothing primitives - -appPredefined :: Term -> Err (Term,Bool) -appPredefined t = case t of - App f x0 -> do - (x,_) <- appPredefined x0 - case f of - -- one-place functions - Q (mod,f) | mod == cPredef -> - case x of - (K s) | f == cLength -> retb $ EInt $ length s - (K s) | f == cIsUpper -> retb $ if (all isUpper s) then predefTrue else predefFalse - (K s) | f == cToUpper -> retb $ K $ map toUpper s - (K s) | f == cToLower -> retb $ K $ map toLower s - (K s) | f == cError -> retb $ Error s - - _ -> retb t - - -- two-place functions - App (Q (mod,f)) z0 | mod == cPredef -> do - (z,_) <- appPredefined z0 - case (norm z, norm x) of - (EInt i, K s) | f == cDrop -> retb $ K (drop i s) - (EInt i, K s) | f == cTake -> retb $ K (take i s) - (EInt i, K s) | f == cTk -> retb $ K (take (max 0 (length s - i)) s) - (EInt i, K s) | f == cDp -> retb $ K (drop (max 0 (length s - i)) s) - (K s, K t) | f == cEqStr -> retb $ if s == t then predefTrue else predefFalse - (K s, K t) | f == cOccur -> retb $ if substring s t then predefTrue else predefFalse - (K s, K t) | f == cOccurs -> retb $ if any (flip elem t) s then predefTrue else predefFalse - (EInt i, EInt j) | f == cEqInt -> retb $ if i==j then predefTrue else predefFalse - (EInt i, EInt j) | f == cLessInt -> retb $ if i<j then predefTrue else predefFalse - (EInt i, EInt j) | f == cPlus -> retb $ EInt $ i+j - (_, t) | f == cShow && notVar t -> retb $ foldrC $ map K $ words $ render (ppTerm Unqualified 0 t) - (_, K s) | f == cRead -> retb $ Cn (identS s) --- because of K, only works for atomic tags - (_, t) | f == cToStr -> trm2str t >>= retb - _ -> retb t ---- prtBad "cannot compute predefined" t - - -- three-place functions - App (App (Q (mod,f)) z0) y0 | mod == cPredef -> do - (y,_) <- appPredefined y0 - (z,_) <- appPredefined z0 - case (z, y, x) of - (ty,op,t) | f == cMapStr -> retf $ mapStr ty op t - _ | f == cEqVal && notVar y && notVar x -> retb $ if y==x then predefTrue else predefFalse - _ -> retb t ---- prtBad "cannot compute predefined" t - - _ -> retb t ---- prtBad "cannot compute predefined" t - _ -> retb t - ---- should really check the absence of arg variables - where - retb t = return (retc t,True) -- no further computing needed - retf t = return (retc t,False) -- must be computed further - retc t = case t of - K [] -> t - K s -> foldr1 C (map K (words s)) - _ -> t - norm t = case t of - Empty -> K [] - C u v -> case (norm u,norm v) of - (K x,K y) -> K (x +++ y) - _ -> t - _ -> t - notVar t = case t of - Vr _ -> False - App f a -> notVar f && notVar a - _ -> True ---- would need to check that t is a value - foldrC ts = if null ts then Empty else foldr1 C ts - --- read makes variables into constants - -predefTrue = QC (cPredef,cPTrue) -predefFalse = QC (cPredef,cPFalse) - -substring :: String -> String -> Bool -substring s t = case (s,t) of - (c:cs, d:ds) -> (c == d && substring cs ds) || substring s ds - ([],_) -> True - _ -> False - -trm2str :: Term -> Err Term -trm2str t = case t of - R ((_,(_,s)):_) -> trm2str s - T _ ((_,s):_) -> trm2str s - V _ (s:_) -> trm2str s - C _ _ -> return $ t - K _ -> return $ t - S c _ -> trm2str c - Empty -> return $ t - _ -> Bad (render (text "cannot get Str from term" <+> ppTerm Unqualified 0 t)) - --- simultaneous recursion on type and term: type arg is essential! --- But simplify the task by assuming records are type-annotated --- (this has been done in type checking) -mapStr :: Type -> Term -> Term -> Term -mapStr ty f t = case (ty,t) of - _ | elem ty [typeStr,typeTok] -> App f t - (_, R ts) -> R [(l,mapField v) | (l,v) <- ts] - (Table a b,T ti cs) -> T ti [(p,mapStr b f v) | (p,v) <- cs] - _ -> t - where - mapField (mty,te) = case mty of - Just ty -> (mty,mapStr ty f te) - _ -> (mty,te) --} diff --git a/src/compiler/GF/Compile/Compute/ConcreteNew.hs b/src/compiler/GF/Compile/Compute/ConcreteNew.hs index f9edc931c..a9ae63960 100644 --- a/src/compiler/GF/Compile/Compute/ConcreteNew.hs +++ b/src/compiler/GF/Compile/Compute/ConcreteNew.hs @@ -15,7 +15,7 @@ import GF.Grammar.Lockfield(isLockLabel,lockRecType) --unlockRecord,lockLabel import GF.Compile.Compute.Value hiding (Error) import GF.Compile.Compute.Predef(predef,predefName,delta) import GF.Data.Str(Str,glueStr,str2strings,str,sstr,plusStr,strTok) -import GF.Data.Operations(Err,err,errIn,maybeErr,combinations,mapPairsM) +import GF.Data.Operations(Err,err,errIn,maybeErr,mapPairsM) import GF.Data.Utilities(mapFst,mapSnd) import GF.Infra.Option import Control.Monad(ap,liftM,liftM2) -- ,unless,mplus @@ -318,7 +318,7 @@ strsFromValue t = case t of return [strTok (str2strings def) vars | def <- d0, vars <- [[(str2strings v, map sstr c) | (v,c) <- zip vv c0] | - vv <- combinations v0] + vv <- sequence v0] ] VFV ts -> concat # mapM strsFromValue ts VStrs ts -> concat # mapM strsFromValue ts diff --git a/src/compiler/GF/Compile/Update.hs b/src/compiler/GF/Compile/Update.hs index 4c1520961..143a4f96f 100644 --- a/src/compiler/GF/Compile/Update.hs +++ b/src/compiler/GF/Compile/Update.hs @@ -109,8 +109,9 @@ rebuildModule cwd gr mo@(i,mi@(ModInfo mt stat fs_ me mw ops_ med_ msrc_ env_ js -- add the instance opens to an incomplete module "with" instances Just (ext,incl,ops) -> do let (infs,insts) = unzip ops - let stat' = ifNull MSComplete (const MSIncomplete) - [i | i <- is, notElem i infs] + let stat' = if all (flip elem infs) is + then MSComplete + else MSIncomplete unless (stat' == MSComplete || stat == MSIncomplete) (checkError ("module" <+> i <+> "remains incomplete")) ModInfo mt0 _ fs me' _ ops0 _ fpath _ js <- lookupModule gr ext |
