From 6753fdae72dc6be7cdac5f2ec09fc42d8f0b4b2e Mon Sep 17 00:00:00 2001 From: krasimir Date: Sun, 25 Oct 2009 18:01:04 +0000 Subject: strip some redundant constructors from GF.Grammar.Grammar --- src/GF/Grammar/Binary.hs | 8 -------- src/GF/Grammar/Grammar.hs | 6 ------ src/GF/Grammar/Lookup.hs | 8 -------- src/GF/Grammar/Macros.hs | 21 +-------------------- src/GF/Grammar/PatternMatch.hs | 10 ---------- 5 files changed, 1 insertion(+), 52 deletions(-) (limited to 'src/GF/Grammar') diff --git a/src/GF/Grammar/Binary.hs b/src/GF/Grammar/Binary.hs index e22e1dc87..6f5d8b817 100644 --- a/src/GF/Grammar/Binary.hs +++ b/src/GF/Grammar/Binary.hs @@ -140,12 +140,9 @@ instance Binary Term where put (ExtR x y) = putWord8 20 >> put (x,y) put (Table x y) = putWord8 21 >> put (x,y) put (T x y) = putWord8 22 >> put (x,y) - put (TSh x y) = putWord8 23 >> put (x,y) put (V x y) = putWord8 24 >> put (x,y) put (S x y) = putWord8 25 >> put (x,y) - put (Val x y z) = putWord8 26 >> put (x,y,z) put (Let x y) = putWord8 27 >> put (x,y) - put (Alias x y z) = putWord8 28 >> put (x,y,z) put (Q x y) = putWord8 29 >> put (x,y) put (QC x y) = putWord8 30 >> put (x,y) put (C x y) = putWord8 31 >> put (x,y) @@ -180,12 +177,9 @@ instance Binary Term where 20 -> get >>= \(x,y) -> return (ExtR x y) 21 -> get >>= \(x,y) -> return (Table x y) 22 -> get >>= \(x,y) -> return (T x y) - 23 -> get >>= \(x,y) -> return (TSh x y) 24 -> get >>= \(x,y) -> return (V x y) 25 -> get >>= \(x,y) -> return (S x y) - 26 -> get >>= \(x,y,z) -> return (Val x y z) 27 -> get >>= \(x,y) -> return (Let x y) - 28 -> get >>= \(x,y,z) -> return (Alias x y z) 29 -> get >>= \(x,y) -> return (Q x y) 30 -> get >>= \(x,y) -> return (QC x y) 31 -> get >>= \(x,y) -> return (C x y) @@ -208,7 +202,6 @@ instance Binary Patt where put (PInt x) = putWord8 6 >> put x put (PFloat x) = putWord8 7 >> put x put (PT x y) = putWord8 8 >> put (x,y) - put (PVal x y z) = putWord8 9 >> put (x,y,z) put (PAs x y) = putWord8 10 >> put (x,y) put (PNeg x) = putWord8 11 >> put x put (PAlt x y) = putWord8 12 >> put (x,y) @@ -229,7 +222,6 @@ instance Binary Patt where 6 -> get >>= \x -> return (PInt x) 7 -> get >>= \x -> return (PFloat x) 8 -> get >>= \(x,y) -> return (PT x y) - 9 -> get >>= \(x,y,z) -> return (PVal x y z) 10 -> get >>= \(x,y) -> return (PAs x y) 11 -> get >>= \x -> return (PNeg x) 12 -> get >>= \(x,y) -> return (PAlt x y) diff --git a/src/GF/Grammar/Grammar.hs b/src/GF/Grammar/Grammar.hs index a4223585a..70153c454 100644 --- a/src/GF/Grammar/Grammar.hs +++ b/src/GF/Grammar/Grammar.hs @@ -136,15 +136,11 @@ data Term = | Table Term Term -- ^ table type: @P => A@ | T TInfo [Case] -- ^ table: @table {p => c ; ...}@ - | TSh TInfo [Cases] -- ^ table with disjunctive patters (only back end opt) | V Type [Term] -- ^ table given as course of values: @table T [c1 ; ... ; cn]@ | S Term Term -- ^ selection: @t ! p@ - | Val Term Type Int -- ^ parameter value number: @T # i# | Let LocalDef Term -- ^ local definition: @let {t : T = a} in b@ - | Alias Ident Type Term -- ^ constant and its definition, used in inlining - | Q Ident Ident -- ^ qualified constant from a package | QC Ident Ident -- ^ qualified constructor from a package @@ -175,8 +171,6 @@ data Patt = | PFloat Double -- ^ float literal pattern: @1.2@ -- only abstract | PT Type Patt -- ^ type-annotated pattern - | PVal Patt Type Int -- ^ parameter value number: @T # i# - | PAs Ident Patt -- ^ as-pattern: x@p | PImplArg Patt -- ^ placeholder for pattern for implicit argument @{p}@ diff --git a/src/GF/Grammar/Lookup.hs b/src/GF/Grammar/Lookup.hs index 62796aeed..19dde6d09 100644 --- a/src/GF/Grammar/Lookup.hs +++ b/src/GF/Grammar/Lookup.hs @@ -27,7 +27,6 @@ module GF.Grammar.Lookup ( lookupParams, lookupParamValues, lookupFirstTag, - lookupValueIndex, lookupIndexValue, allOrigInfos, allParamValues, @@ -183,13 +182,6 @@ lookupFirstTag gr m c = do v:_ -> return v _ -> Bad (render (text "no parameter values given to type" <+> ppIdent c)) -lookupValueIndex :: SourceGrammar -> Type -> Term -> Err Term -lookupValueIndex gr ty tr = do - ts <- allParamValues gr ty - case lookup tr $ zip ts [0..] of - Just i -> return $ Val tr ty i - _ -> Bad $ render (text "no index for" <+> ppTerm Unqualified 0 tr <+> text "in" <+> ppTerm Unqualified 0 ty) - lookupIndexValue :: SourceGrammar -> Type -> Int -> Err Term lookupIndexValue gr ty i = do ts <- allParamValues gr ty diff --git a/src/GF/Grammar/Macros.hs b/src/GF/Grammar/Macros.hs index 7aa61c2c9..9062fb2b5 100644 --- a/src/GF/Grammar/Macros.hs +++ b/src/GF/Grammar/Macros.hs @@ -329,9 +329,6 @@ term2patt :: Term -> Err Patt term2patt trm = case termForm trm of Ok ([], Vr x, []) | x == identW -> return PW | otherwise -> return (PV x) - Ok ([], Val te ty x, []) -> do - te' <- term2patt te - return (PVal te' ty x) Ok ([], Con c, aa) -> do aa' <- mapM term2patt aa return (PC c aa') @@ -382,7 +379,6 @@ patt2term :: Patt -> Term patt2term pt = case pt of PV x -> Vr x PW -> Vr identW --- not parsable, should not occur - PVal v t i -> Val (patt2term v) t i PMacro c -> Cn c PM p c -> Q p c @@ -441,7 +437,6 @@ strsFromTerm t = case t of ] FV ts -> mapM strsFromTerm ts >>= return . concat Strs ts -> mapM strsFromTerm ts >>= return . concat - Alias _ _ d -> strsFromTerm d --- should not be needed... _ -> Bad (render (text "cannot get Str from term" <+> ppTerm Unqualified 0 t)) -- | to print an Str-denoting term as a string; if the term is of wrong type, the error msg @@ -502,21 +497,11 @@ composOp co trm = i' <- changeTableType co i return (T i' cc') - TSh i cc -> - do cc' <- mapPairListM (co . snd) cc - i' <- changeTableType co i - return (TSh i' cc') - V ty vs -> do ty' <- co ty vs' <- mapM co vs return (V ty' vs') - Val te ty i -> - do te' <- co te - ty' <- co ty - return (Val te' ty' i) - Let (x,(mt,a)) b -> do a' <- co a mt' <- case mt of @@ -524,10 +509,7 @@ composOp co trm = _ -> return mt b' <- co b return (Let (x,(mt',a')) b') - Alias c ty d -> - do v <- co d - ty' <- co ty - return $ Alias c ty' v + C s1 s2 -> do v1 <- co s1 v2 <- co s2 @@ -583,7 +565,6 @@ collectOp co trm = case trm of RecType r -> concatMap (co . snd) r P t i -> co t T _ cc -> concatMap (co . snd) cc -- not from patterns --- nor from type annot - TSh _ cc -> concatMap (co . snd) cc -- not from patterns --- nor from type annot V _ cc -> concatMap co cc --- nor from type annot Let (x,(mt,a)) b -> maybe [] co mt ++ co a ++ co b C s1 s2 -> co s1 ++ co s2 diff --git a/src/GF/Grammar/PatternMatch.hs b/src/GF/Grammar/PatternMatch.hs index 828a2e365..b8f7eff7d 100644 --- a/src/GF/Grammar/PatternMatch.hs +++ b/src/GF/Grammar/PatternMatch.hs @@ -76,11 +76,6 @@ tryMatch (p,t) = do isInConstantFormt = True -- tested already in matchPattern trym p t' = case (p,t') of - (PVal _ _ i, (_,Val _ _ j,_)) - | i == j -> return [] - | otherwise -> Bad $ "no match of values" - (PVal pa _ _,_) -> trym pa t' - (_, (_,Val te _ _,_)) -> tryMatch (p, te) (_,(x,Empty,y)) -> trym p (x,K [],y) -- because "" = [""] = [] (PW, _) | isInConstantFormt -> return [] -- optimization with wildcard (PV x, _) | isInConstantFormt -> return [(x,t)] @@ -110,9 +105,6 @@ tryMatch (p,t) = do [(p,snd a) | (l,p) <- r, let Just a = lookup l r'] return (concat matches) (PT _ p',_) -> trym p' t' - (_, ([],Alias _ _ d,[])) -> tryMatch (p,d) - --- (PP (IC "Predef") (IC "CC") [p1,p2], ([],K s, [])) -> do (PAs x p',_) -> do subst <- trym p' t' @@ -152,9 +144,7 @@ isInConstantForm trm = case trm of R r -> all (isInConstantForm . snd . snd) r K _ -> True Empty -> True - Alias _ _ t -> isInConstantForm t EInt _ -> True - Val _ _ _ -> True _ -> False ---- isInArgVarForm trm varsOfPatt :: Patt -> [Ident] -- cgit v1.2.3