mirror of
https://github.com/GrammaticalFramework/gf-core.git
synced 2026-04-23 19:42:50 -06:00
more dead code
This commit is contained in:
krangelov
@@ -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)
|
||||
-}
|
||||
@@ -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
|
||||
|
||||
Reference in New Issue
Block a user