summaryrefslogtreecommitdiff
path: root/src/GF/Grammar
diff options
context:
space:
mode:
Diffstat (limited to 'src/GF/Grammar')
-rw-r--r--src/GF/Grammar/Binary.hs8
-rw-r--r--src/GF/Grammar/Grammar.hs6
-rw-r--r--src/GF/Grammar/Lookup.hs8
-rw-r--r--src/GF/Grammar/Macros.hs21
-rw-r--r--src/GF/Grammar/PatternMatch.hs10
5 files changed, 1 insertions, 52 deletions
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]
generated by cgit v1.2.3 (git 2.39.1) at 2026-05-20 23:23:43 +0000