summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/GF/Compile/Abstract/Compute.hs1
-rw-r--r--src/GF/Compile/Concrete/AppPredefined.hs1
-rw-r--r--src/GF/Compile/Concrete/Compute.hs11
-rw-r--r--src/GF/Compile/Concrete/TypeCheck.hs2
-rw-r--r--src/GF/Compile/GrammarToGFCC.hs2
-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
10 files changed, 4 insertions, 66 deletions
diff --git a/src/GF/Compile/Abstract/Compute.hs b/src/GF/Compile/Abstract/Compute.hs
index 29cc73525..d5c9a163c 100644
--- a/src/GF/Compile/Abstract/Compute.hs
+++ b/src/GF/Compile/Abstract/Compute.hs
@@ -123,7 +123,6 @@ tryMatch (p,t) = do
matches <- mapM tryMatch (zip pp tt)
return (concat matches)
(PT _ p',_) -> trym p' t'
- (_, ([],Alias _ _ d,[])) -> tryMatch (p,d)
(PAs x p',_) -> do
subst <- trym p' t'
return $ (x,t) : subst
diff --git a/src/GF/Compile/Concrete/AppPredefined.hs b/src/GF/Compile/Concrete/AppPredefined.hs
index 154d76821..95effb51d 100644
--- a/src/GF/Compile/Concrete/AppPredefined.hs
+++ b/src/GF/Compile/Concrete/AppPredefined.hs
@@ -136,7 +136,6 @@ trm2str :: Term -> Err Term
trm2str t = case t of
R ((_,(_,s)):_) -> trm2str s
T _ ((_,s):_) -> trm2str s
- TSh _ ((_,s):_) -> trm2str s
V _ (s:_) -> trm2str s
C _ _ -> return $ t
K _ -> return $ t
diff --git a/src/GF/Compile/Concrete/Compute.hs b/src/GF/Compile/Concrete/Compute.hs
index 5a232a2a4..dc4937509 100644
--- a/src/GF/Compile/Concrete/Compute.hs
+++ b/src/GF/Compile/Concrete/Compute.hs
@@ -311,20 +311,15 @@ computeTermOpt rec gr = comput True where
-- course-of-values table: look up by index, no pattern matching needed
- V ptyp ts -> case v' of
- Val _ _ i -> comp g $ ts !! i
- _ -> do
+ V ptyp ts -> do
vs <- allParamValues gr ptyp
case lookupR v' (zip vs [0 .. length vs - 1]) of
Just i -> comp g $ ts !! i
_ -> return $ S t' v' -- if v' is not canonical
T _ cc -> do
- let v2 = case v' of
- Val te _ _ -> te
- _ -> v'
- case matchPattern cc v2 of
+ case matchPattern cc v' of
Ok (c,g') -> comp (g' ++ g) c
- _ | isCan v2 -> Bad (render (text "missing case" <+> ppTerm Unqualified 0 v2 <+> text "in" <+> ppTerm Unqualified 0 t))
+ _ | isCan v' -> Bad (render (text "missing case" <+> ppTerm Unqualified 0 v' <+> text "in" <+> ppTerm Unqualified 0 t))
_ -> return $ S t' v' -- if v' is not canonical
S (T i cs) e -> prawitz g i (flip S v') cs e
diff --git a/src/GF/Compile/Concrete/TypeCheck.hs b/src/GF/Compile/Concrete/TypeCheck.hs
index e5d2a9160..0d72b3c67 100644
--- a/src/GF/Compile/Concrete/TypeCheck.hs
+++ b/src/GF/Compile/Concrete/TypeCheck.hs
@@ -90,8 +90,6 @@ inferLType gr g trm = case trm of
checkError (text "cannot infer type of canonical constant" <+> ppTerm Unqualified 0 trm)
]
- Val _ ty i -> termWith trm $ return ty
-
Vr ident -> termWith trm $ checkLookup ident g
Typed e t -> do
diff --git a/src/GF/Compile/GrammarToGFCC.hs b/src/GF/Compile/GrammarToGFCC.hs
index 2a31d2b75..c284b176c 100644
--- a/src/GF/Compile/GrammarToGFCC.hs
+++ b/src/GF/Compile/GrammarToGFCC.hs
@@ -173,7 +173,6 @@ mkTerm tr = case tr of
EInt i -> C.C $ fromInteger i
R rs -> C.R [mkTerm t | (_, (_,t)) <- rs]
P t l -> C.P (mkTerm t) (C.C (mkLab l))
- TSh _ _ -> error $ show tr
T _ cs -> C.R [mkTerm t | (_,t) <- cs] ------
V _ cs -> C.R [mkTerm t | t <- cs]
S t p -> C.P (mkTerm t) (mkTerm p)
@@ -507,7 +506,6 @@ term2term fun cgr env@(labels,untyps,typs) tr = case tr of
_ | tr == x -> t
_ -> GM.composSafeOp (mkBranch x t) tr
- valNum (Val _ _ i) = traceD (show i) $ EInt $ toInteger i ----Val
valNum tr = maybe (valNumFV $ tryFV tr) EInt $ Map.lookup tr untyps
where
tryFV tr = case GM.appForm tr of
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 07:21:29 +0000